Find and replace with bold in cells

  • Follow


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!
0
Reply Utf 1/27/2010 10:09:02 PM

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]






On Wed, 27 Jan 2010 14:09:02 -0800, Dan
<Dan@discussions.microsoft.com> wrote:

>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!
0
Reply Chip 1/27/2010 11:45:32 PM


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" wrote:

> 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]
> 
> 
> 
> 
> 
> 
> On Wed, 27 Jan 2010 14:09:02 -0800, Dan
> <Dan@discussions.microsoft.com> wrote:
> 
> >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!
> .
> 
0
Reply Utf 1/28/2010 8:12:01 PM

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

"Dan" wrote:

> 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" wrote:
> 
> > 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]
> > 
> > 
> > 
> > 
> > 
> > 
> > On Wed, 27 Jan 2010 14:09:02 -0800, Dan
> > <Dan@discussions.microsoft.com> wrote:
> > 
> > >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!
> > .
> > 
0
Reply Utf 1/29/2010 5:40:01 PM

3 Replies
555 Views

(page loaded in 0.583 seconds)


Reply: