在VBA中使用HTML标记将单词范围转换为字符串

时间:2018-11-28 16:59:54

标签: vba ms-word word-vba

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

你好,我是 Alice

我想获取一个包含以下内容的字符串:

Hello I am <b>Alice</b>

(如果它也适用于项目符号列表和其他格式,那将很棒。)

我正在使用Microsoft Visual Basic for Applications 7.0。 我是VBA的新手,我在Internet上找到的许多代码都不适用于我,因为我的版本很旧。不幸的是,在我看来,下载最新版本不是一个选择。

这是一个代码示例,可以将段落转换为字符串而无需格式化:

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)

我在Internet上进行了一些研究,发现建议将Range复制到剪贴板并使用Clipboard.getText。不幸的是Clipboard.getText甚至没有为我编译。

3 个答案:

答案 0 :(得分:0)

我知道将Word中的格式转换为html标签的一种方法是使用Access。如果创建的Access表的字段为Long Text数据类型且Rich Text为Text Format并将其Word文本导入其中,则在查询Access将Text放回Word时,它会显示为html标记文本。 / p>

答案 1 :(得分:0)

您可以使用以下代码作为起点。但是,显然,您必须对其进行扩展以处理您所关心的所有标签。

private void serialPort1_DataReceived(object sender, System.IO.Ports.SerialDataReceivedEventArgs e)
{
    string Data = serialPort1.ReadExisting();

    this.Invoke((MethodInvoker)delegate
    {
        textBox2.AppendText(Data);
    });
}

答案 2 :(得分:0)

我通常在Outlook中用于创建HTMLBody的几个函数。将来可能会对某人有所帮助。此过程将按字符进行检查,因此可能需要一点时间。我在excel中的预格式化单元格中使用了此功能,但也应该在Word文档中使用。

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