TableMaker 2.0

Dick very recently put up a function that takes an Excel range and whips up some HTML to create a table. I loved that idea, and I asked if I could flesh it out. With Dick’s green light, I created a Sub() that captures each cell’s font family, font style, and font color, as well as the cell’s alignment and background color. It retains Dick’s option to use headers or not.

The sub spits the table to the clipboard. To get it there, in the VBE use Tools/References and check the Microsoft Forms 2.0 Object Library.

The table is a mixture of HTML and deprecated HTML (I’m not a purist.) I played with capturing the font size, but never liked how it came out so I commented it out. In creating HTML or CSS, many times you need to uses double-quotes (“) around the parameters. You can get by without it if the parameters are a single word, Arial for instance, but not for Times New Roman. Getting double-quotes in a text string requires you to escape them with another set of double quotes, creating double double-quotes (“”) and my eyes start to cross. I trick I use is to define a string*1 constant DQ equal to double double double-quotes (“”””). And then where I want quotes to appear in the HTML or CSS, I just concatenate in DQ. I used it throughout the Sub().

Public Sub MakeHTMLTable()

   Const DQ    As String * 1 = “”””   ‘double double double-quotes
   Dim DataObj As New MSForms.DataObject
   ‘Check VBE Tools/References Microsoft Forms 2.0 Object Library
   Dim rInput  As Range
   Dim rRow    As Range
   Dim rCell   As Range
   Dim sReturn As String
   Dim TextAlign As String
   Dim VertAlign As String
   Dim BgColor As String
   Dim FontColor As String
   Dim FontFace As String
   Dim CellContents As String
   Dim UseHeaders As Long
   Dim FontSize As Long
   Dim R As Long, C As Long
   Dim Red     As String
   Dim Green   As String
   Dim Blue    As String
   Dim TEMP    As Variant

   Set rInput = Selection
   R = rInput.Rows.Count
   C = rInput.Columns.Count

   UseHeaders = MsgBox(“Use Table Headers for your ” & R & “-row by ” & C & “-column table?”, _
                       vbYesNoCancel + vbQuestion, “DK’s Table Maker”)
   If UseHeaders = vbCancel Then Exit Sub

   sReturn = “.LT.table border=1 rules=all cellpadding=” & DQ & “5” & DQ & “.GT.”

   If UseHeaders = vbYes Then
      sReturn = sReturn & “.LT.tr.GT..LT.th bgcolor = #0055e5.GT. .LT./th.GT.”

      For Each rCell In rInput.Rows(1).Cells
         sReturn = sReturn & “.LT.th bgcolor = #0055e5 align=” & _
                   DQ & “center” & DQ & “.GT.” & “.LT.font face=” & _
                   DQ & “Arial” & DQ & “.GT.” & Chr$(rCell.Column + 64) & _
                   “.LT./font.GT..LT./th.GT.”
      Next rCell

      sReturn = sReturn & “.LT./tr.GT.” & vbNewLine
   End If

   For Each rRow In rInput.Rows
      sReturn = sReturn & “.LT.tr.GT.”

      If UseHeaders = vbYes Then
         sReturn = sReturn & “.LT.th bgcolor = #0055e5 align=” & _
                   DQ & “center” & DQ & “.GT.” & “.LT.font face=” & _
                   DQ & “Arial” & DQ & “.GT.” & rRow.Row & “.LT./font.GT..LT./th.GT.”
      End If

      For Each rCell In rRow.Cells

         CellContents = rCell.Text
         If Len(CellContents) = 0 Then CellContents = “ ”

         Select Case rCell.HorizontalAlignment
            Case xlGeneral
               TextAlign = “left”
               If IsNumeric(rCell.Value) Then TextAlign = “right”
               If IsError(rCell.Value) Then TextAlign = “center”
            Case xlLeft
               TextAlign = “left”
            Case xlCenter
               TextAlign = “center”
            Case xlRight
               TextAlign = “right”
            Case xlJustify
               TextAlign = “center”
         End Select

         FontFace = DQ & rCell.Font.Name & DQ
         ‘FontSize = rCell.Font.Size
         ‘If FontSize .LT. 12 Then FontSize = 12

         TEMP = rCell.Font.Color
         Red = Hex(TEMP And 255)
         Green = Hex(TEMP 256 And 255)
         Blue = Hex(TEMP 256 ^ 2 And 255)
         If Len(Red) = 1 Then Red = “0” & Red
         If Len(Green) = 1 Then Green = “0” & Green
         If Len(Blue) = 1 Then Blue = “0” & Blue
         FontColor = “#” & Red & Green & Blue

         TEMP = rCell.Interior.Color
         Red = Hex(TEMP And 255)
         Green = Hex(TEMP 256 And 255)
         Blue = Hex(TEMP 256 ^ 2 And 255)
         If Len(Red) = 1 Then Red = “0” & Red
         If Len(Green) = 1 Then Green = “0” & Green
         If Len(Blue) = 1 Then Blue = “0” & Blue
         BgColor = “#” & Red & Green & Blue

         sReturn = sReturn & “.LT.td align=” & TextAlign & _
                   ” bgcolor=” & BgColor & “.GT.”
         sReturn = sReturn & “.LT.font face=” & FontFace & _
                   ” color=” & FontColor & “.GT.”

         With rCell.Font
            If .Italic Then sReturn = sReturn & “.LT.i.GT.”
            If .Bold Then sReturn = sReturn & “.LT.b.GT.”
            If .Underline .LT..GT. xlNone Then sReturn = sReturn & “.LT.u.GT.”
            If .Strikethrough Then sReturn = sReturn & “.LT.strike.GT.”
            If .Subscript Then sReturn = sReturn & “.LT.sub.GT.”
            If .Superscript Then sReturn = sReturn & “.LT.sup.GT.”
         End With

         sReturn = sReturn & CellContents

         With rCell.Font   ‘in reverse order
            If .Superscript Then sReturn = sReturn & “.LT./sup.GT.”
            If .Subscript Then sReturn = sReturn & “.LT./sub.GT.”
            If .Strikethrough Then sReturn = sReturn & “.LT./strike.GT.”
            If .Underline .LT..GT. xlNone Then sReturn = sReturn & “.LT./u.GT.”
            If .Bold Then sReturn = sReturn & “.LT./b.GT.”
            If .Italic Then sReturn = sReturn & “.LT./i.GT.”
         End With

         sReturn = sReturn & “.LT./font.GT..LT./td.GT.”
      Next rCell
      sReturn = sReturn & “.LT./tr.GT.” & vbNewLine
   Next rRow

   sReturn = sReturn & “.LT./table.GT.”

   DataObj.SetText sReturn
   DataObj.PutInClipboard

End Sub

 
In the above replace the ampersand-amp-semicolon with an ampersand, the .LT. with < (35 times) and the .GT. with > (34 times.) The macro accurately reproduced a very ugly selected range as this double-ugly table:

  A B C D E F G H I
1 1 2 3 4 5 6 7 8 9
2 2 4 6 8 10 12 14 16 18
3 3 #N/A 9 12 15 18 21 24 27
4 4 8.00E+00 12 16 20 24 28.000 32 36
5 The quick brown fox jumps over the lazy dog!
6 6 12 18 24 30 36 42 48  

That table uses every color in the default Excel palette, and the fonts use most of them. The fonts in Row 5, from left to right, are:

  • Courier new
  • Times New Roman
  • Verdana
  • Comic Sans MS
  • Georgia
  • Tahoma
  • Trebuchet MS
  • Arial Black
  • Impact

There are assorted alignments and number formats sprinkled throughout. If the spreadsheet cell is empty, the macro puts a non-breaking space in the table as a placeholder. There is a considerable amount of bloat in the output, as it’s all done at the cell level. v3.0 will swap out the message-box interaction with a form that allows you to pick only what you are interested in. It’ll be out someday. Seeing how long it took MS to get Excel to edit at the character level, that’ll never be out.

Somethings I learned about WordPress: WordPress prefers the colors in #HEX format. When I used RBG, WordPress would wrap the RGB(r,g,b) in double quotes, and then not honor it! The fix was to use the HEX() function and a leading octothorpe. It turns out, WordPress wraps all the parameters, anyway. I don’t know how to capture the heading colors (I suspect it takes an API) so for now, whatever is the DDoE WordPress default (looks like a pale beige to me) is what you get here. (The sub’s code actually sets Windows Classic for the headers, but it gets overridden by CSS. Just as well–doesn’t really look like a window.) And I don’t think WordPress does subscript well when there’s no text to subordinate to. Cell C2 is specifed as superscript and E3 as subscript/strike-through. All I can say is that it’s clear on the spreadsheet.

…mrt:roll:

Posted in Uncategorized

20 thoughts on “TableMaker 2.0

  1. Pretty cool. This must have been a bit of fun to write! :)

    I wonder why you’re doing .LT. and .GT. replacements? I thought WordPress or that code tag handled things ok?

  2. Rather than writing your own code to handle formatting, why not Excel do the hard work?

    Option 1: Completely unexplored. {grin}
    With 2007 or later, the default format is a zip file with xml content. Why not just extract the information associated with the cells on interest.

    Option 2: I’ve done enough research to know this is eminently doable and not that difficult, though I don’t have the code for it.

    Save the Excel file as a 2003 HTML file. Now, open this as a text file and save the contents of the style tag and the only div tag in the file.

    Variant of option 2: Since the HTML file does not have row and column information, before carrying out option 2, insert a new row 1 and a new column 1 and add formulas for column and ids respectively.

  3. Hi Dick –

    What I think is that standalone angle brackets are OK, but that opposing angle brackets are considered HTML pairs, and the result is elided. That’s not so good if you’re trying to compose HTML.

    Here’s a test of code from above, no substitutions:

             With rCell.Font
                If .Italic Then sReturn = sReturn & “<i>”
                If .Bold Then sReturn = sReturn & “<b>”
                If .Underline <> xlNone Then sReturn = sReturn & “<u>”
                If .Strikethrough Then sReturn = sReturn & “<strike>”
                If .Subscript Then sReturn = sReturn & “<sub>”
                If .Superscript Then sReturn = sReturn & “<sup>”
             End With

    All those lines end with HTML pairs inside quotes, and the .Underline line has “not equals” in the middle. Let’s see how it goes.

    …mrt

  4. Dick –

    In comments, all seems to work as we would want. In the WordPress Editor I left a test post for you to review of unsubstituted code from the macro. Ampersands and Not-equals got munged. Angle brackets inside quotes were OK. Lines of code (not from the macro)

    If a < c and c > a then

    End If

    get rendered

    If aa then

    End If

    (I first used b instead of c. That got rendered as the bold tag, and then WordPress added a closing bold tag for me :-) )

    …mrt

  5. Hi Rob –

    Thanks. It was fun, and a bit frustrating. The table would paste and render fine on my desktop, but not to WordPress. When I changed from RGB to named colors, WordPress rendered OK, which then led me to the HEX option. Now, everyone seem happy.

    See my discussion with Dick. It appears I over compensated, but IN THE EDITOR, angle bracket pairs not protected by quotes are still elided.

    Hope you find it useful.

    …mrt

  6. Alternative ?

    Public Sub MakeHTMLTable()
      Const c01 As String = “<td bgcolor = # align=!  font face=~|~ color= ^>*</td>”
       
      sq = Filter(Application.Transpose(Cells(1, 1).CurrentRegion.Columns(1).Offset(, Cells(1, 1).CurrentRegion.Columns.Count)), “”)
      For Each cl In Cells(1, 1).CurrentRegion
        With cl
          c03 = Replace(c01, “!”, IIf(VarType(cl.Value) = 8, “left”, “right”))
          c03 = Replace(c03, “#”, “#” & Format(Hex(.Interior.Color 256 ^ 2), “00”) & Format(Hex((.Interior.Color Mod 256 ^ 2) 256), “00”) & Format(Hex(.Interior.Color Mod 256), “00”))
          With .Font
            c03 = Replace(c03, “^”, “#” & Format(Hex(.Color 256 ^ 2), “00”) & Format(Hex((.Color Mod 256 ^ 2) 256), “00”) & Format(Hex(.Color Mod 256), “00”))
            c03 = Replace(c03, “|”, .Name)
            c03 = Replace(c03, “*”, Switch(.Italic, “<i>”, .Bold, “<b>”, .Underline <> xlNone, “<u>”, .Strikethrough, “<strike>”, .Subscript, “<sub>”, .Superscript, “<sup>”) & cl.Value & Switch(.Superscript, “</sup>”, .Subscript, “</sub>”, .Strikethrough, “</strike>”, .Underline <> xlNone, “</u>”, .Bold, “</b>”, .Italic, “</i>”))
            sq(cl.Row – 1) = sq(cl.Row – 1) & c03
          End With
        End With
      Next
       
      If MsgBox(“Use Table Headers for your “ & Cells(1, 1).CurrentRegion.Rows.Count & “-row by “ & Cells(1, 1).CurrentRegion.Columns.Count & “-column table?”, vbYesNoCancel + vbQuestion, “DK’s Table Maker”) = vbYes Then sq(0) = Replace(sq(0), “td”, “th”)
       
      Open “E:OF able.html” For Output As #1
        Print #1, Replace(“<table border=1 rules=all cellpadding=~5~ ><tr>” & Join(sq, vbCrLf & “<tr>”) & “</table>”, “~”, Chr(34))
      Close #1
    End Sub
  7. Hi Tushar –

    Option 1 looks to be for the serious explorers. Guys like you, Dick, and Rob. I’d have to screw up my fortitude for a long time before I attempt to parse a zipped file still zipped. ;-)

    As long as the cell properties that have HTML counterparts are all that’s wanted, I think this approach is simpler. No saving required. However, if you start to want vertical alignment, true font size, border style etc, then you’re into CSS. And if Microsoft has done it, steal it.

    Of course the option I’d truly like is to be able to copy the selection to the clipboard in CSS/HTML in the first place. No macro required.

    But then I wouldn’t have had Dick’s example of how to do this.

    …mrt

  8. Not completely trusting WordPress and updating the post, and thinking I might really screw things up, here is the macro in a comment. No substitutions required.

    Public Sub MakeHTMLTable()

       Const DQ    As String * 1 = “”””   ‘double double double-quotes
       Dim DataObj As New MSForms.DataObject
       ‘Check VBE Tools/References Microsoft Forms 2.0 Object Library
       Dim rInput  As Range
       Dim rRow    As Range
       Dim rCell   As Range
       Dim sReturn As String
       Dim TextAlign As String
       Dim VertAlign As String
       Dim BgColor As String
       Dim FontColor As String
       Dim FontFace As String
       Dim CellContents As String
       Dim UseHeaders As Long
       Dim FontSize As Long
       Dim R As Long, C As Long
       Dim Red     As String
       Dim Green   As String
       Dim Blue    As String
       Dim TEMP    As Variant

       Set rInput = Selection
       R = rInput.Rows.Count
       C = rInput.Columns.Count

       UseHeaders = MsgBox(“Use Table Headers for your ” & R & “-row by ” & C & “-column table?”, _
                           vbYesNoCancel + vbQuestion, “DK’s Table Maker”)
       If UseHeaders = vbCancel Then Exit Sub

       sReturn = “<table border=1 rules=all cellpadding=” & DQ & “5” & DQ & “>”

       If UseHeaders = vbYes Then
          sReturn = sReturn & “<tr><th bgcolor = #0055e5>&nbsp;</th>”

          For Each rCell In rInput.Rows(1).Cells
             sReturn = sReturn & “<th bgcolor = #0055e5 align=” & _
                       DQ & “center” & DQ & “>” & “<font face=” & _
                       DQ & “Arial” & DQ & “>” & Chr$(rCell.Column + 64) & _
                       “</font></th>”
          Next rCell

          sReturn = sReturn & “</tr>” & vbNewLine
       End If

       For Each rRow In rInput.Rows
          sReturn = sReturn & “<tr>”

          If UseHeaders = vbYes Then
             sReturn = sReturn & “<th bgcolor = #0055e5 align=” & _
                       DQ & “center” & DQ & “>” & “<font face=” & _
                       DQ & “Arial” & DQ & “>” & rRow.Row & “</font></th>”
          End If

          For Each rCell In rRow.Cells

             CellContents = rCell.Text
             If Len(CellContents) = 0 Then CellContents = “&nbsp;”

             Select Case rCell.HorizontalAlignment
                Case xlGeneral
                   TextAlign = “left”
                   If IsNumeric(rCell.Value) Then TextAlign = “right”
                   If IsError(rCell.Value) Then TextAlign = “center”
                Case xlLeft
                   TextAlign = “left”
                Case xlCenter
                   TextAlign = “center”
                Case xlRight
                   TextAlign = “right”
                Case xlJustify
                   TextAlign = “center”
             End Select

             FontFace = DQ & rCell.Font.Name & DQ
             ‘FontSize = rCell.Font.Size
             ‘If FontSize < 12 Then FontSize = 12

             TEMP = rCell.Font.Color
             Red = Hex(TEMP And 255)
             Green = Hex(TEMP 256 And 255)
             Blue = Hex(TEMP 256 ^ 2 And 255)
             If Len(Red) = 1 Then Red = “0” & Red
             If Len(Green) = 1 Then Green = “0” & Green
             If Len(Blue) = 1 Then Blue = “0” & Blue
             FontColor = “#” & Red & Green & Blue

             TEMP = rCell.Interior.Color
             Red = Hex(TEMP And 255)
             Green = Hex(TEMP 256 And 255)
             Blue = Hex(TEMP 256 ^ 2 And 255)
             If Len(Red) = 1 Then Red = “0” & Red
             If Len(Green) = 1 Then Green = “0” & Green
             If Len(Blue) = 1 Then Blue = “0” & Blue
             BgColor = “#” & Red & Green & Blue

             sReturn = sReturn & “<td align=” & TextAlign & _
                       ” bgcolor=” & BgColor & “>”
             sReturn = sReturn & “<font face=” & FontFace & _
                       ” color=” & FontColor & “>”

             With rCell.Font
                If .Italic Then sReturn = sReturn & “<i>”
                If .Bold Then sReturn = sReturn & “<b>”
                If .Underline <> xlNone Then sReturn = sReturn & “<u>”
                If .Strikethrough Then sReturn = sReturn & “<strike>”
                If .Subscript Then sReturn = sReturn & “<sub>”
                If .Superscript Then sReturn = sReturn & “<sup>”
             End With

             sReturn = sReturn & CellContents

             With rCell.Font   ‘in reverse order
                If .Superscript Then sReturn = sReturn & “</sup>”
                If .Subscript Then sReturn = sReturn & “</sub>”
                If .Strikethrough Then sReturn = sReturn & “</strike>”
                If .Underline <> xlNone Then sReturn = sReturn & “</u>”
                If .Bold Then sReturn = sReturn & “</b>”
                If .Italic Then sReturn = sReturn & “</i>”
             End With

             sReturn = sReturn & “</font></td>”
          Next rCell
          sReturn = sReturn & “</tr>” & vbNewLine
       Next rRow

       sReturn = sReturn & “</table>”

       DataObj.SetText sReturn
       DataObj.PutInClipboard

    End Sub

    …mrt

  9. When I use ‘SaveAs Webpage’ the filesize is 23kB, when using my macro it’s size is 4kB.

  10. And I rewrote to:

    Sub MakeHTMLTable()
      Const c01 As String = “*”
       
      sq = Split(String(Cells(1, 1).CurrentRegion.Rows.Count, “|”), “|”)
      For Each cl In Cells(1, 1).CurrentRegion
        With cl
          c02 = Replace(c01, String(6, “*”), Format(Hex(.Interior.Color 256 ^ 2), “00”) &amp; Format(Hex((.Interior.Color Mod 256 ^ 2) 256), “00”) &amp; Format(Hex(.Interior.Color Mod 256), “00”))
          c02 = Replace(c02, String(5, “*”), IIf(VarType(cl.Value) = 8, “left”, “right”))
          With .Font
            c02 = Replace(c02, String(4, “*”), .Name)
            c02 = Replace(c02, String(3, “*”), Format(Hex(.Color 256 ^ 2), “00”) &amp; Format(Hex((.Color Mod 256 ^ 2) 256), “00”) &amp; Format(Hex(.Color Mod 256), “00”))
            c02 = Replace(c02, String(2, “*”), .Size)
            For j = 1 To 6
              If Choose(j, .Italic, .Bold, .Underline  xlNone, .Strikethrough, .Subscript, .Superscript) Then c02 = Replace(c02, “*”, Choose(j, “<i>*”, “<b>*</b>”, “*”, “<strike>*</strike>”, “*”, “*”))
            Next
            sq(cl.Row) = sq(cl.Row) &amp; Replace(c02, “*”, cl.Value)
          End With
        End With
      Next
       
      If MsgBox(“Use Table Headers for your ” &amp; UBound(sq) + 1 &amp; “-row by ” &amp; Cells(1, 1).CurrentRegion.Columns.Count &amp; “-column table?”, 36) = vbYes Then sq(0) = “” &amp; Join(Evaluate(“transpose(char(row(1:” &amp; Cells(1, 1).CurrentRegion.Columns.Count &amp; “)+64))”), “”)
       
      Open “E:OF able.htm” For Output As #1
        Print #1, Replace(“” &amp; Join(Filter(sq, “&lt;”), vbCrLf &amp; “”) &amp; “”, “~”, Chr(34))
      Close #1
    End Sub<code>
  11. And now with the correct tags

    Sub MakeHTMLTable()
      Const c01 As String = “<td bgcolor = #****** align=***** ><font face=~****~  color= #*** size=**>*</font>”
       
      sq = Split(String(Cells(1, 1).CurrentRegion.Rows.Count, “|”), “|”)
      For Each cl In Cells(1, 1).CurrentRegion
        With cl
          c02 = Replace(c01, String(6, “*”), Format(Hex(.Interior.Color 256 ^ 2), “00”) & Format(Hex((.Interior.Color Mod 256 ^ 2) 256), “00”) & Format(Hex(.Interior.Color Mod 256), “00”))
          c02 = Replace(c02, String(5, “*”), IIf(VarType(cl.Value) = 8, “left”, “right”))
          With .Font
            c02 = Replace(c02, String(4, “*”), .Name)
            c02 = Replace(c02, String(3, “*”), Format(Hex(.Color 256 ^ 2), “00”) & Format(Hex((.Color Mod 256 ^ 2) 256), “00”) & Format(Hex(.Color Mod 256), “00”))
            c02 = Replace(c02, String(2, “*”), .Size)
            For j = 1 To 6
              If Choose(j, .Italic, .Bold, .Underline <> xlNone, .Strikethrough, .Subscript, .Superscript) Then c02 = Replace(c02, “*”, Choose(j, “<i>*</>”, “<b>*</b>”, “<u>*</u>”, “<strike>*</strike>”, “<sub>*</sub>”, “<sup>*</sup>”))
            Next
            sq(cl.Row) = sq(cl.Row) & Replace(c02, “*”, cl.Value)
          End With
        End With
      Next
       
      If MsgBox(“Use Table Headers for your “ & UBound(sq) + 1 & “-row by “ & Cells(1, 1).CurrentRegion.Columns.Count & “-column table?”, 36) = vbYes Then sq(0) = “<td align=center >” & Join(Evaluate(“transpose(char(row(1:” & Cells(1, 1).CurrentRegion.Columns.Count & “)+64))”), “<td align=center>”)
       
      Open “E:OF able.htm” For Output As #1
        Print #1, Replace(“<table border=1 rules=all cellpadding=~5~ ><tr>” & Join(Filter(sq, “<“), vbCrLf & “<tr>”) & “</table>”, “~”, Chr(34))
      Close #1
    End Sub
  12. Rob: Thanks for that link. It tries to do what I described in my ‘option 2’ except that the implementation — and here I have to use a very technical term — sucks. {grin}

    Step through the code and sData contains the HTML from a temporary file (AppDataLocalTempmsohtmlclip11clip.htm)

    Unfortunately, the result from GetHTMLClipboard is code that starts with some TR tag. That means one must add the appropriate TABLE tags. Worse, the TD tags reference various style classes such as xl65 and xl67 but the class definitions (from the STYLE tag) are excluded!

    That means the result is *nothing* like what I have in the worksheet.

    It’s unfortunate because the GetHTMLClipboard code could have easily included the STYLE tag and the TABLE tag rather than the out and out incorrect StartFragment and EndFragment stuff.

    I have to leave for a meeting but when I get back I’ll post a solution that retains the cell format.

  13. To be honest, I was kind of winging it, hoping someone else would make sense of it.
    I used a ClipboardViewer program to see the “HTML Format” text in the clipboard. There are other formats available, like XML Spreadsheet, SLYK, etc.
    Some other format might get you closer to what’s needed.

  14. Rob, I think the technique you uncovered in the MS KB is pretty useful, despite the shortcomings that Tushar noted.

    I noticed that it doesn’t encode any special characters, like letters with accents. It notices superscript and subscript formats, but not bold, italics, or underline.

    I coded up a function that would convert cell contents into a full html string that would re-produce nearly all of the formatting, encode special characters, etc. The problem was that it didn’t nest the tags properly. I found that most browsers would render it properly though, even though it would fail validation. I found that running the page through a program called “Tidy” fixed it. Still, the extra step was kind of annoying. One day I’ll go back and fix that routine.

  15. OK, I tried it again removing the block that snips out the style info at the beginning. Leaving it in uses MS’s god-awful styles loaded with all kinds of junk. Tidy is good at stripping those out too, but still annoying.

  16. I found some code that pulls the HTML Format from the clipboard, and places it in a userform TextBox
    Code is here

    I copied Michael’s table to Excel, then copied the range, and ran that code I found.
    So, now I have the clipboard content. It’s got some metadata at the start, and html following.
    I copied the html bit to its own file (text.html) and opened it in Firefox. Looked ok to me… bold, italics, and all!

    I kinda hate messing with the clipboard. It just looks too much like code pressed out by the macro recorder.
    Gotta say, it’s pretty interesting what Excel does every time you press Ctrl-C.


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.