在 VBA 中将单词范围转换为带有 HTML 标签的字符串 [英] Convert a Word Range to a String with HTML tags in VBA

问题描述

我有一个 Word 文档，我需要将其中的一些段落复制到 VBA 中的字符串中.这样做时，必须将文本格式转换为 HTML 标记.例如，如果我的段落如下所示:

你好，我是爱丽丝.

我想得到一个包含以下内容的字符串:

你好，我是<b>Alice</b>

(如果它也适用于项目符号列表和其他类型的格式，那就太好了).

我使用的是 Microsoft Visual Basic for Applications 7.0.我是 VBA 新手，我在 Internet 上找到的许多代码对我不起作用，因为我的版本很旧.不幸的是，在我的情况下，下载更新版本不是一种选择.

这是一个代码示例，用于将段落转换为没有格式的字符串:

将 pParagraph 变暗为段落'... 在某些时候， pParagraph 被设置为文档的一个段落将 pRange 调暗为范围将 pString 调暗为字符串设置 pRange = ActiveDocument.Range(Start:=pParagraph.Range.Start, End:=pParagraph.Range.End - 1)pString = Trim(pRange.Text)

我在互联网上做了一些研究，发现建议将范围复制到剪贴板并使用 Clipboard.getText.不幸的是，Clipboard.getText 甚至不能为我编译.

解决方案

只是我通常用来在 Outlook 中创建 HTMLBody 的几个函数.它可能会在未来帮助某人.此过程将按字符检查，因此可能需要一点时间.我在 excel 的预先格式化的单元格中使用它，但也应该处理 word 文档.

函数 Convert2HTML(myCell As Range) As StringDim bldTagOn, itlTagOn, ulnTagOn, colTagOn, phaTagOn As BooleanDim i、chrCount、spaceCount 作为整数Dim chrCol, chrLastCol, htmlTxt As StringbldTagOn = 假itlTagOn = 假ulnTagOn = 假colTagOn = FalsephaTagOn = 假chrCol = 无"htmlTxt = 
"chrCount = myCell.Characters.Count空间计数 = 0对于 i = 1 到 chrCount使用 myCell.Characters(i, 1)如果 myCell.Characters(i, 4).Text = ""然后不是phaTagOnhtmlTxt = htmlTxt &"<p style='text-indent: 40px'>>phaTagOn = 真别的如果 myCell.Characters(i, 4).Text = ""然后 phaTagOnhtmlTxt = htmlTxt &"</p><p style='text-indent: 40px'>>phaTagOn = 真万一万一如果 (.Font.Color) 那么chrCol = GetCol(.Font.Color)如果不是 colTagOn 那么htmlTxt = htmlTxt &"<字体颜色=#"&铬&>>colTagOn = 真别的如果 chrCol <>chrLastCol 然后 htmlTxt = htmlTxt &</font><font color=#";&铬&>>万一别的chrCol = 无"如果 colTagOn 那么htmlTxt = htmlTxt &</font>"colTagOn = False万一万一chrLastCol = chrCol如果 .Font.Bold = True 那么如果不是 bldTagOn 那么htmlTxt = htmlTxt &<b>"bldTagOn = 真万一别的如果 bldTagOn 那么htmlTxt = htmlTxt &</b>"bldTagOn = 假万一万一如果 .Font.Italic = True 那么如果不是 itlTagOn 那么htmlTxt = htmlTxt &<i>"itlTagOn = 真万一别的如果 itlTagOn 那么htmlTxt = htmlTxt &</i>"itlTagOn = 假万一万一如果 .Font.Underline >0 那么如果不是 ulnTagOn 那么htmlTxt = htmlTxt &<u>"ulnTagOn = 真万一别的如果 ulnTagOn 那么htmlTxt = htmlTxt &</u>"ulnTagOn = 假万一万一如果 (Asc(.Text) = 10) 那么htmlTxt = htmlTxt &
"别的htmlTxt = htmlTxt &.文本万一结束于下一个如果 colTagOn 那么htmlTxt = htmlTxt &</font>"colTagOn = False万一如果 bldTagOn 那么htmlTxt = htmlTxt &</b>"bldTagOn = 假万一如果 itlTagOn 那么htmlTxt = htmlTxt &</i>"itlTagOn = 假万一如果 ulnTagOn 那么htmlTxt = htmlTxt &</u>"ulnTagOn = 假万一如果 phaTagOn 那么htmlTxt = htmlTxt &</p>"phaTagOn = 假万一htmlTxt = htmlTxt &</div>"fnConvert2HTML = htmlTxt结束函数函数 GetCol(strCol As String) As StringDim rVal、gVal、bVal 作为字符串strCol = Right("000000" & Hex(strCol), 6)bVal = Left(strCol, 2)gVal = Mid(strCol, 3, 2)rVal = Right(strCol, 2)GetCol = rVal &gVal &值结束函数

I have a Word document and I need to copy some paragraph of it into a string in VBA. When doing so, the text formatting must be converted to HTML tags. For example if my paragraph looks like this:

Hello I am Alice.

I want to get a string that contains:

Hello I am <b>Alice</b>

(And it would be great if it also work for bulleted list and other kind of formatting).

I am using Microsoft Visual Basic for Applications 7.0. I am new to VBA and a lot of code I found on Internet does not work for me because my version is old. Unfortunately, downloading a more recent version is not an option in my case.

Here is a code sample that works to convert a paragraph to a string without formatting:

Dim pParagraph As Paragraph
'... at some point, pParagraph is set to a paragraph of the document

Dim pRange As Range
Dim pString As String
Set pRange = ActiveDocument.Range(Start:=pParagraph.Range.Start, End:=pParagraph.Range.End - 1)
pString = Trim(pRange.Text)

I did some research on Internet and found the advise to copy the Range to the clipboard and to use Clipboard.getText. Unfortunately Clipboard.getText does not even compile for me.

解决方案

Just a couple of functions i usually use to create HTMLBody in outlook. It may help someone in the future. This process will check by character so it may take a little bit of time. I am using this in a pre-formatted cell in excel but should also work on word document.

Function Convert2HTML(myCell As Range) As String
    Dim bldTagOn, itlTagOn, ulnTagOn, colTagOn, phaTagOn As Boolean
    Dim i, chrCount, spaceCount As Integer
    Dim chrCol, chrLastCol, htmlTxt As String
    
    bldTagOn = False
    itlTagOn = False
    ulnTagOn = False
    colTagOn = False
    phaTagOn = False
    chrCol = "NONE"
    htmlTxt = "<div>"
    chrCount = myCell.Characters.Count
    spaceCount = 0
    For i = 1 To chrCount
        With myCell.Characters(i, 1)
        
            If myCell.Characters(i, 4).Text = "    " And Not phaTagOn Then
                htmlTxt = htmlTxt & "<p style='text-indent: 40px'>"
                phaTagOn = True
            Else
                If myCell.Characters(i, 4).Text = "    " And phaTagOn Then
                    htmlTxt = htmlTxt & "</p><p style='text-indent: 40px'>"
                    phaTagOn = True
                End If
            End If
                
            If (.Font.Color) Then
                chrCol = GetCol(.Font.Color)
                If Not colTagOn Then
                    htmlTxt = htmlTxt & "<font color=#" & chrCol & ">"
                    colTagOn = True
                Else
                    If chrCol <> chrLastCol Then htmlTxt = htmlTxt & "</font><font color=#" & chrCol & ">"
                End If
            Else
                chrCol = "NONE"
                If colTagOn Then
                    htmlTxt = htmlTxt & "</font>"
                    colTagOn = False
                End If
            End If
            chrLastCol = chrCol
            
            If .Font.Bold = True Then
                If Not bldTagOn Then
                    htmlTxt = htmlTxt & "<b>"
                    bldTagOn = True
                End If
            Else
                If bldTagOn Then
                    htmlTxt = htmlTxt & "</b>"
                    bldTagOn = False
                End If
            End If
    
            If .Font.Italic = True Then
                If Not itlTagOn Then
                    htmlTxt = htmlTxt & "<i>"
                    itlTagOn = True
                End If
            Else
                If itlTagOn Then
                    htmlTxt = htmlTxt & "</i>"
                    itlTagOn = False
                End If
            End If
    
            If .Font.Underline > 0 Then
                If Not ulnTagOn Then
                    htmlTxt = htmlTxt & "<u>"
                    ulnTagOn = True
                End If
            Else
                If ulnTagOn Then
                    htmlTxt = htmlTxt & "</u>"
                    ulnTagOn = False
                End If
            End If
            
            If (Asc(.Text) = 10) Then
                htmlTxt = htmlTxt & "<br>"
            Else
                htmlTxt = htmlTxt & .Text
            End If
        End With
    Next
    
    If colTagOn Then
        htmlTxt = htmlTxt & "</font>"
        colTagOn = False
    End If
    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
    If phaTagOn Then
        htmlTxt = htmlTxt & "</p>"
        phaTagOn = False
    End If
    htmlTxt = htmlTxt & "</div>"
    fnConvert2HTML = htmlTxt
End Function

Function GetCol(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)
    GetCol = rVal & gVal & bVal
End Function

这篇关于在 VBA 中将单词范围转换为带有 HTML 标签的字符串的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！