在 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屋!
查看全文