5
\$\begingroup\$

I have several functions, whose common end goal is to make it possible to write the contents of an Excel cell to Microsoft Access and be able to bring it back from Access as well, all while retaining formatting! The function that I want to review, below, works very well but it is somewhat slow. It takes a cell as an argument and returns a string with HTML-like tags indicating where to put formats.

Example:

Input:

enter image description here

Output:

<c=#4BACC6><s=11>4<s=08>. <c=#000000>Dema<b>nde i<i>nterne </b>pour hydrauliqu</i>e : Les achats de castings de roue (aubes, plafond, ceinture) sont à acheter très rapidement tel qu’indiqué dans la cédule TTS.[LF] Cette demande<c=#FF0000> doit être...

The part that is slow is continually accessing every single character through Range.Characters. I'm aware it is very expensive and I'd like to replace it with something else. If it was possible to take that into memory it would go a lot faster I'm sure!

To test the function, write some formatted text to a cell and simply use the following line while the cell is selected:

debug.Print fnConvert2HTML(Activecell)


Function fnConvert2HTML(myCell As Range) As String
    Dim bldTagOn As Boolean, itlTagOn As Boolean, ulnTagOn As Boolean, colTagOn As Boolean, sizTagOn As Boolean
    Dim i As Integer, chrCount As Integer
    Dim chrSiz As String, chrLastSiz As String, htmlTxt As String
    Dim decCol As Long, decLastCol As Long
    Dim chr As String

    bldTagOn = False
    itlTagOn = False
    ulnTagOn = False
    colTagOn = False
    sizTagOn = False
    decCol = 0 
    chrCount = myCell.Characters.Count

    For i = 1 To chrCount
        With myCell.Characters(i, 1)

            decCol = .Font.Color
            If decCol <> decLastCol Then
                htmlTxt = htmlTxt & "<c=#" & fnGetCol(.Font.Color) & ">"
                decLastCol = decCol
            End If

            chrSiz = .Font.Size
            If Len(chrSiz) = 1 Then chrSiz = "0" & chrSiz
            If Not chrLastSiz = chrSiz Then
                htmlTxt = htmlTxt & "<s=" & chrSiz & ">"
            End If
            chrLastSiz = chrSiz

            If .Font.Bold = False Then
                If bldTagOn Then
                    htmlTxt = htmlTxt & "</b>"
                    bldTagOn = False
                End If
            Else
                If Not bldTagOn Then
                    htmlTxt = htmlTxt & "<b>"
                    bldTagOn = True
                End If
            End If

            If .Font.Italic = False Then
                If itlTagOn Then
                    htmlTxt = htmlTxt & "</i>"
                    itlTagOn = False
                End If
            Else
                If Not itlTagOn Then
                    htmlTxt = htmlTxt & "<i>"
                    itlTagOn = True
                End If
            End If

            If .Font.Underline <= 0 Then
                If ulnTagOn Then
                    htmlTxt = htmlTxt & "</u>"
                    ulnTagOn = False
                End If
            Else
                If Not ulnTagOn Then
                    htmlTxt = htmlTxt & "<u>"
                    ulnTagOn = True
                End If
            End If

            chr = .Text
            If (chr = vbLf) Then
                htmlTxt = htmlTxt & "[LF]"
            Else
                htmlTxt = htmlTxt & chr
            End If
        End With
    Next

    'Closes the tags at the end if need be
    If bldTagOn Then
        htmlTxt = htmlTxt & "</b>"
        bldTagOn = False
    End If
    If itlTagOn Then
        htmlTxt = htmlTxt & "</i>"
        itlTagOn = False
    End If
    If ulnTagOn Then
        htmlTxt = htmlTxt & "</u>"
        ulnTagOn = False
    End If
    fnConvert2HTML = htmlTxt
End Function

For reference here is the fnGetCol function:

Function fnGetCol(strCol As String) As String
    Dim rVal, gVal, bVal As String
    strCol = Right("000000" & Hex(strCol), 6)
    bVal = Left(strCol, 2)
    gVal = Mid(strCol, 3, 2)
    rVal = Right(strCol, 2)
    fnGetCol = rVal & gVal & bVal
End Function

I'm aware this is not "real" HTML, it's a construct I made, which is fine because the returning function is made by me and works well (no speed issues).

\$\endgroup\$
  • \$\begingroup\$ If someone has a function that accomplishes a similar goal but faster, I'd gladly use it too even if it means ditching my simili-HTML for real HTML. I tried looking into the Outlook library for that but it turns out I'm not very good at navigating librairies. \$\endgroup\$ – David G Aug 18 '16 at 20:21
  • 1
    \$\begingroup\$ It's an intriguing problem, so I spent some time researching but didn't come up with any magic solution. Ultimately, I think the answer lies in taking the cell contents and using Word Automation to write the cell contents to an RTF file, then reading the RTF file contents and parsing that. See references here and here for some hopefully helpful information. \$\endgroup\$ – PeterT Aug 18 '16 at 21:50
  • \$\begingroup\$ Isn't the formatting data stored in the backend xml file for xlsx? Or am I misremembering? \$\endgroup\$ – Raystafarian Aug 18 '16 at 23:21
  • 1
    \$\begingroup\$ @DavidG Speaking from experience, the .Characters() collection is Shlemiel the painter on steroids. Fine for small numbers of characters, but once you get a couple of sentences in there, it starts getting really slow really fast. \$\endgroup\$ – Kaz Aug 19 '16 at 9:07
  • \$\begingroup\$ @Zak Ah, that would explain why sometimes it takes forever and Excel stops responding when there are really long cells. \$\endgroup\$ – David G Aug 19 '16 at 13:00
3
\$\begingroup\$

This isn't a full answer, but information related to @Raystafarian's comment above. (I can't fit all the info into a comment)

I created a workbook with the following entered into Range("A1"):

enter image description here

Tearing apart the xlsx file and opening it as a zip, I was able to find this formatted string in the sharedStrings.xml file. It has all the fully formatted text as shown below.

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<sst xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" count="1" uniqueCount="1">
  <si>
    <r>
      <t xml:space="preserve">This </t>
    </r>
    <r>
      <rPr><b/><i/><sz val="11"/><color rgb="FF7030A0"/><rFont val="Calibri"/><family val="2"/><scheme val="minor"/></rPr>
      <t>wildass</t>
    </r>
    <r>
      <rPr><sz val="11"/><color theme="1"/><rFont val="Calibri"/><family val="2"/><scheme val="minor"/></rPr>
      <t xml:space="preserve"> </t>
    </r>
    <r>
      <rPr><sz val="11"/><color rgb="FFFF0000"/><rFont val="Calibri"/><family val="2"/><scheme val="minor"/></rPr>
      <t>text</t>
    </r>
    <r>
      <rPr><sz val="11"/><color theme="1"/><rFont val="Calibri"/><family val="2"/><scheme val="minor"/></rPr>
      <t xml:space="preserve"> is </t>
    </r>
    <r>
      <rPr><b/><i/><sz val="11"/><color theme="1"/><rFont val="Calibri"/><family val="2"/><scheme val="minor"/></rPr>
      <t>formatted</t>
    </r>
    <r>
      <rPr><sz val="11"/><color theme="1"/><rFont val="Calibri"/><family val="2"/><scheme val="minor"/></rPr>
      <t xml:space="preserve"> </t>
    </r>
    <r>
      <rPr><sz val="11"/><color rgb="FF00B050"/><rFont val="Calibri"/><family val="2"/><scheme val="minor"/></rPr>
      <t>several</t>
    </r>
    <r>
      <rPr><sz val="11"/><color theme="1"/><rFont val="Calibri"/><family val="2"/><scheme val="minor"/></rPr>
      <t xml:space="preserve"> </t>
    </r>
    <r>
      <rPr><sz val="11"/><color theme="1"/><rFont val="Tahoma"/><family val="2"/></rPr>
      <t>different</t>
    </r>
    <r>
      <rPr><sz val="11"/><color theme="1"/><rFont val="Calibri"/><family val="2"/><scheme val="minor"/></rPr>
      <t xml:space="preserve"> </t>
    </r>
    <r>
      <rPr><sz val="16"/><color theme="1"/><rFont val="Calibri"/><family val="2"/><scheme val="minor"/></rPr>
      <t>ways.</t>
    </r>
  </si>
</sst>

With this information, you'd have to

  1. Save a copy your xlsx file
  2. Rename the file to change the extension to .zip
  3. Extract the xl/sharedStrings.xml file from the zip archive
  4. Read that XML file and process the strings inside

There are likely more details to the process. I've looked at xlsx/zip archives on a number of occasions, but have never tried to manipulate the linked data within it.

\$\endgroup\$
  • \$\begingroup\$ Interesting solution, although I'm not entirely sure it would be faster. I only have around 40 cells to format like this at a time, but it's something users would do every time they save to the database. Right now it takes around 10 seconds per save (total time including opening and closing the connections etc). Not sure if I want to invest time in this solution given my context. Sounds really cool though I'll look into it if I have less prioritary things. \$\endgroup\$ – David G Aug 19 '16 at 12:38

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.