Find and replace with bold in cells

D

Dan

I have a VB6 program that is executing Excel 2007, opening a worksheet, and
extracting some of the cells to write data to a text file. Some of the cells
contain bold text on some (not necessarily all) of the text in the cell. I
would like to do a find and replace on the bold tagging to replace it with
something like "<b>" at the start of it and "</b>" at the end of it. How do I
set this up in VB6? Thanks!
 
C

Chip Pearson

The following function will return a string including <b> and </b>
tags from the text of cell R.

Function BoldMarkup(R As Range) As String

Dim N As Long
Dim S As String
Dim InBold As Boolean

If R.Cells.Count > 1 Then
Exit Function
End If
If R.HasFormula = True Then
Exit Function
End If
If Len(R.Text) = 0 Then
Exit Function
End If

If Len(R.Text) = 1 Then
If R.Characters(1, 1).Font.Bold Then
BoldMarkup = "<b>" & R.Text & "</b>"
Exit Function
End If
End If

For N = 1 To Len(R.Text)
If R.Characters(N, 1).Font.Bold = True Then
If InBold = False Then
S = S & "<b>" & R.Characters(N, 1).Text
InBold = True
Else
S = S & R.Characters(N, 1).Text
If N = Len(R.Text) Then
S = S & "</b>"
End If
End If
Else
If InBold = True Then
S = S & "</b>" & R.Characters(N, 1).Text
InBold = False
Else
S = S & R.Characters(N, 1).Text
End If
End If
Next N
BoldMarkup = S

End Function


Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]
 
D

Dan

Chip,

Thank you for your reply. I have included your code in my program and it
works some of the time. Here is a code snippet that I'm using:

Dim CellRange As Excel.Range

For I = 1 To 200
For J = 1 To 11
Set CellRange = ExcelWorksheet.Cells(I, J)
TextStr = BoldMarkup(CellRange)
Next J
Next I

If I set the upper limit of the "For J" loop to 1 (instead of 11), the code
works. However, when I have it loop on the first 11 columns in the worksheet,
it gives me the following error:

Unable to set the Text Property of the Characters class

The error occurs the first time that "R.Characters(N, 1).Text" is referenced
in your function. I've tried to figure out what's wrong with my code that
it's not interacting with your function properly, but I can't find anything
that makes it work. Can you see how I should change my code to eliminate this
error?

Thanks!

Dan

Chip Pearson said:
The following function will return a string including <b> and </b>
tags from the text of cell R.

Function BoldMarkup(R As Range) As String

Dim N As Long
Dim S As String
Dim InBold As Boolean

If R.Cells.Count > 1 Then
Exit Function
End If
If R.HasFormula = True Then
Exit Function
End If
If Len(R.Text) = 0 Then
Exit Function
End If

If Len(R.Text) = 1 Then
If R.Characters(1, 1).Font.Bold Then
BoldMarkup = "<b>" & R.Text & "</b>"
Exit Function
End If
End If

For N = 1 To Len(R.Text)
If R.Characters(N, 1).Font.Bold = True Then
If InBold = False Then
S = S & "<b>" & R.Characters(N, 1).Text
InBold = True
Else
S = S & R.Characters(N, 1).Text
If N = Len(R.Text) Then
S = S & "</b>"
End If
End If
Else
If InBold = True Then
S = S & "</b>" & R.Characters(N, 1).Text
InBold = False
Else
S = S & R.Characters(N, 1).Text
End If
End If
Next N
BoldMarkup = S

End Function


Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]






I have a VB6 program that is executing Excel 2007, opening a worksheet, and
extracting some of the cells to write data to a text file. Some of the cells
contain bold text on some (not necessarily all) of the text in the cell. I
would like to do a find and replace on the bold tagging to replace it with
something like "<b>" at the start of it and "</b>" at the end of it. How do I
set this up in VB6? Thanks!
Click to expand...
.
Click to expand...
 
D

Dan

Can anyone help me with this error message that I'm getting? Thanks!

Dan said:
Chip,

Thank you for your reply. I have included your code in my program and it
works some of the time. Here is a code snippet that I'm using:

Dim CellRange As Excel.Range

For I = 1 To 200
For J = 1 To 11
Set CellRange = ExcelWorksheet.Cells(I, J)
TextStr = BoldMarkup(CellRange)
Next J
Next I

If I set the upper limit of the "For J" loop to 1 (instead of 11), the code
works. However, when I have it loop on the first 11 columns in the worksheet,
it gives me the following error:

Unable to set the Text Property of the Characters class

The error occurs the first time that "R.Characters(N, 1).Text" is referenced
in your function. I've tried to figure out what's wrong with my code that
it's not interacting with your function properly, but I can't find anything
that makes it work. Can you see how I should change my code to eliminate this
error?

Thanks!

Dan

Chip Pearson said:
The following function will return a string including <b> and </b>
tags from the text of cell R.

Function BoldMarkup(R As Range) As String

Dim N As Long
Dim S As String
Dim InBold As Boolean

If R.Cells.Count > 1 Then
Exit Function
End If
If R.HasFormula = True Then
Exit Function
End If
If Len(R.Text) = 0 Then
Exit Function
End If

If Len(R.Text) = 1 Then
If R.Characters(1, 1).Font.Bold Then
BoldMarkup = "<b>" & R.Text & "</b>"
Exit Function
End If
End If

For N = 1 To Len(R.Text)
If R.Characters(N, 1).Font.Bold = True Then
If InBold = False Then
S = S & "<b>" & R.Characters(N, 1).Text
InBold = True
Else
S = S & R.Characters(N, 1).Text
If N = Len(R.Text) Then
S = S & "</b>"
End If
End If
Else
If InBold = True Then
S = S & "</b>" & R.Characters(N, 1).Text
InBold = False
Else
S = S & R.Characters(N, 1).Text
End If
End If
Next N
BoldMarkup = S

End Function


Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]






I have a VB6 program that is executing Excel 2007, opening a worksheet, and
extracting some of the cells to write data to a text file. Some of the cells
contain bold text on some (not necessarily all) of the text in the cell. I
would like to do a find and replace on the bold tagging to replace it with
something like "<b>" at the start of it and "</b>" at the end of it. How do I
set this up in VB6? Thanks!
Click to expand...
.
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Concantenate which keeps bold of some parts. 5
Find sometimes ignores Application.FindFormat 3
vba to convert htm tags 2
Code to do a simple clean of one column by copying and pasting(finding and replacing) phrases in adj 4
Find / Replace 3
Macro that delets all cells containg ALL words in bold 3
Conditional Formating: MAX & MIN 3
VBA - Move cell contents if bold text 2

Top