Convert Excel Cell Text in Bold or Italic to HTML Tags/Convert Cell Line Breaks

[mana]

Option Explicit

Sub test2()
    Dim re1 As Object, re2 As Object
    Dim s As String
    Dim r As Range
    Dim m As Object
    
    Set r = Selection
    s = r.Value(xlRangeValueXMLSpreadsheet)
    
    Set re1 = CreateObject("VBScript.RegExp")
    re1.Global = True
    Set re2 = CreateObject("VBScript.RegExp")
    re2.Global = True
    
    re1.Pattern = "<I>(<Font[\s\S]*?>)([\s\S]*?)(</Font>)*</I>"
    s = re1.Replace(s, "$1&lt;I&gt;$2&lt;/I&gt;$3")
    
  re1.Pattern = "<B>(<Font[\s\S]*?(?!Style)>)([\s\S]*?)(</Font>)*</B>"
    s = re1.Replace(s, "$1&lt;B&gt;$2&lt;/B&gt;$3")
  
    re2.Pattern = "<Style ss:(ID=""s\d*"")>([\s\S]*?)</Style>"
    If re2.test(s) Then
        For Each m In re2.Execute(s)
            If InStr(m.submatches(1), "ss:Bold=""1""") > 0 Then
                re1.Pattern = "(<Cell ss:Style" & m.submatches(0) & "><Data ss:Type=""String"">)([\s\S]*?)(</Data>)"
                s = re1.Replace(s, "$1&lt;B&gt;$2&lt;/B&gt;$3")
            End If
            If InStr(m.submatches(1), "ss:Italic=""1""") > 0 Then
                re1.Pattern = "(<Cell ss:Style" & m.submatches(0) & "><Data ss:Type=""String"">)([\s\S]*?)(</Data>)"
                s = re1.Replace(s, "$1&lt;I&gt;$2&lt;/I&gt;$3")
            End If
        Next
    End If
'
    re1.Pattern = "((<ss:|<)Data[\s\S]*?>)([\s\S]*?)(<(/ss:|/)Data>)"
    s = re1.Replace(s, "$1&lt;P&gt;$3&lt;/P&gt;$4")
    
    re1.Pattern = "& # 10;"　'<--remove space
    s = re1.Replace(s, "&lt;P&gt;&lt;/P&gt;")
        
    r.Offset(, 2).Value(xlRangeValueXMLSpreadsheet) = s
    r.Offset(, 2).ClearFormats
    r.Offset(, 2).Font.Bold = False
    r.Offset(, 2).Font.Italic = False
'
    Set re1 = Nothing
    Set re2 = Nothing
    
End Sub

マナ

[snb]

Or:

Sub M_snb()
    sp = Range("A1:B20")
    sn = Filter(Split(Replace(Replace(Range("A1:D20").Value(11), "</Cell>", "<Cell>"), "</Font>", ""), "<Cell>"), "<Font")
    
    For j = 1 To UBound(sn)
      If InStr(sn(j), "<I>") + InStr(sn(j), "<B>") Then
          sn(j) = Replace(Replace(Replace(Replace(Replace(sn(j), "<I>", Chr(0) & "I" & Chr(1)), "<B>", Chr(0) & "B" & Chr(1)), "</I>", Chr(0) & "/I" & Chr(1)), "</B>", Chr(0) & "/B" & Chr(1)), ">", "<")
          sp((j - 1) \ UBound(sp, 2) + 1, (j - 1) Mod UBound(sp, 2) + 1) = Replace(Replace(Join(Filter(Split(sn(j), "<"), ":", 0), ""), Chr(0), "<"), Chr(1), ">")
      End If
    Next
    
    Range("A1:B20").Offset(25) = sp
End Sub

[gmaxey]

Very nice. Thanks mana

[gmaxey]

snb, Your code throws a type mismatch error. Since it has nothing to do with converting the content of the selected range or column, why do you even bother?

[Paul_Hossler]

Very nice. Thanks mana

Agreed - I learned a little something

However, I don't think I could get all the parameters, etc. correct. I'll have to opt for simplicity over efficiency

[gmaxey]

Paul,

Likewise. This is a case where I was given the fish. A "Deep Sea" fish. I better stay closer to the shore :-). Thanks all of you for your help.

[gmaxey]

Sorry guys, one more question. In mana's code he sets his range to the the selection.

For my purposes, I need to select a column of data and run the code. I don't want to process the first heading row. How do I adapt:

Set r = Selection

such that the range excludes the first row.

I tried this (among other things) but get and error:

Set r = Selection.Offset(1, 0)

Thanks.

[Paul_Hossler]

In Excel, ActiveCell is used a lot

One if the data has no blanks, another if it does

Of course, you could use the second for everything, but I thought I'd show two different ways

This could stand some error checking, but we'll leave that as a homework assignment

Option Explicit


'click somewhere in Col A
Sub Fragment()
    Dim rngToProcess As Range, rStart As Range, rEnd As Range
    
    Set rStart = ActiveCell.EntireColumn.Cells(2, 1)
    Set rEnd = rStart.End(xlDown)
    
    Set rngToProcess = Range(rStart, rEnd)
    
    On Error Resume Next
    Set rngToProcess = rngToProcess.SpecialCells(xlCellTypeConstants, xlTextValues)
    On Error GoTo 0
    
    MsgBox rngToProcess.Address


End Sub




'click somewhere in Col C
Sub Fragment2()
    Dim rngToProcess As Range, rStart As Range, rEnd As Range
    
    Set rStart = ActiveCell.EntireColumn.Cells(2, 1)
    Set rEnd = ActiveSheet.Cells(ActiveSheet.Rows.Count, ActiveCell.Column).End(xlUp)
    
    Set rngToProcess = Range(rStart, rEnd)
    
    On Error Resume Next
    Set rngToProcess = rngToProcess.SpecialCells(xlCellTypeConstants, xlTextValues)
    On Error GoTo 0
    
    MsgBox rngToProcess.Address


End Sub

[gmaxey]

Thanks Pual

[rambleon]

Hi Mana,
In addition to converting Bold and Italic text to web format - which is an excellent piece code, would it be possible to also include conversion of special characters for web, such as ampersand (&), quotes (") and apostrophe (').
Thanks

[snb]

@gmax

To exclude columnheaders:

Sub M_snb()
  sn=cells(1).currentregion.columns(3).offset(1).specialcells(2)
End Sub

[rambleon]

Hi Mana,
This code was working but now it just shows [Running] then Not Responding.
I'm selecting the column to convert on a sheet with 2,200 rows.
Any ideas?
Thanks

[rambleon]

I went back to an earlier version of the file, and your code to convert selected column to html worked fine, so problem was mine.
Sorry,
Thanks