html - Excel 宏 VBA 使用 HTML 标记粗斜体下划线在单元格中强
问题描述
我一直在寻找转换字符串或单元格,例如:
[单元格 B2 示例]
"This is a <b>test</b> cell <i>filled</i> with <strong>randomly placed html tags</strong>."
[需要的输出示例]“这是一个随机放置的 html 标签填充的测试单元格。”
我需要能够<b></b> , <i></i> , <u></u> , <strong></strong>
在同一个单元格或字符串中处理多种类型的标签 ()。
到目前为止,有人帮助我做到了这一点:
Dim Tag, Tend, Pstart, Pend As String
'BOLD Text
Tag = "<b>" ' tag string: start
Tend = "</b>" ' tag string: end
Pstart = 0 ' vector index of Pos()
Pend = 1 ' vector index of Pos()
Dim Cv As String ' Cell value
Dim Cnt As Integer ' instances of bold expressions
Dim Pos() As Variant ' string positions: 0 = start, 1 = End
Dim f As Integer ' loop counter: Cnt
Cv = Range("B2").Value
Cnt = (Len(Cv) - Len(Replace(Cv, Tag, ""))) / 3
ReDim Pos(Cnt, Pend)
For f = 1 To Cnt
Pos(f, Pstart) = InStr(Cv, Tag)
Cv = Left(Cv, Pos(f, Pstart) - 1) & Mid(Cv, Pos(f, Pstart) + Len(Tag), Len(Cv))
Pos(f, Pend) = InStr(Cv, Tend) - 1
Cv = Left(Cv, Pos(f, Pend)) & Mid(Cv, Pos(f, Pend) + Len(Tend) + 1, Len(Cv))
Next f
With Range("B2")
.Font.Bold = False
.Value = Cv
For f = 1 To Cnt
.Characters(Pos(f, Pstart), Pos(f, Pend) - Pos(f, Pstart) + 1).Font.Bold = True
Next f
End With
以上成功地将所需的文本加粗并从单元格中删除了视觉标签。然而,当尝试同时包含斜体、下划线和强标签时,它只会在最后出现。其余的被消灭。
有一个更好的方法吗?多个html标签可以转换成excel字符串或单元格,而不必打开IE等其他应用程序吗?
旁注,至于标签,如果它们的功能与粗体相同会很好,如果这样更容易吗?
解决方案
一旦您分配了单元格的 .Value 属性,任何每个字符的字体格式都会丢失,因此您不能将其作为格式化过程的一部分。
这是一种方法 - 不是防弹的,并且不会考虑(例如)相同标签的嵌套集或无效的 HTML ......
Sub Tester()
Dim c As Range
Set c = ActiveSheet.Range("D5")
ActiveSheet.Range("D2").Copy c 'for testing:copy the input string
FormatTags c, "b", "bold"
FormatTags c, "i", "italic"
FormatTags c, "strong", "bold"
FormatTags c, "u", "underline"
End Sub
Sub FormatTags(c As Range, tag As String, prop As String)
Dim pOpen As Long, pClose As Long, numChars As Long
Dim sOpen, sClose
sOpen = "<" & tag & ">" 'the open tag
sClose = "</" & tag & ">" 'close tag
pOpen = InStr(c.Value, sOpen) 'have an open tag?
Do While pOpen > 0
pClose = InStr(pOpen + 1, c.Value, sClose) 'find next close tag
If pClose > 0 Then
c.Characters(pClose, Len(sClose)).Delete 'remove the close tag first
c.Characters(pOpen, Len(sOpen)).Delete 'remove the open tag
'set the named font property
numChars = pClose - (pOpen + Len(sOpen))
CallByName c.Characters(pOpen, numChars).Font, prop, VbLet, True
pOpen = InStr(c.Value, sOpen) 'find next, if any
Else
Exit Do 'no closing tag - all done
End If
Loop
End Sub
编辑 - 如果您对不涉及 IE 的更通用的方法感兴趣,您可以将 HTML 复制到剪贴板并将其粘贴到单元格中。这将为您提供所需的格式。
例如 - 从这里使用@GMCB 的代码:Injecting RTF code in the Clipboard to paste into MS Word as RTF text via a VBA macro
With ActiveSheet
myClipboard.SetClipboardText .Range("D5").value, "HTML Format"
.Paste Destination:=.Range("D5")
End With
推荐阅读
- php - 基于 WooCommerce 中的用户角色或自定义数据的额外购物车费用
- reactjs - 在服务器上构建 create-react-app 时防止停机
- python - 如何计算文本中词频的最佳 zipf 分布
- pandas - Pandas:如果不是 NaN 则打印(列)
- formatting - Freemarker 格式 BigDecimal 到德语区域设置无法正常工作
- haskell - 堆栈“计划构建失败。”
- python - 使用 python 生成示例(鸢尾花)数据集
- java - sendKeys() 未通过 Selenium 和 Java 使用 WebDriverWait 插入完整值
- oracle - 如何修复“遇到以下符号之一时遇到符号“=:”plsql中的错误
- python - 为什么 pyglet.image 和 texture 这么重?