将 sub 转换为 v.b.a 中的函数，将 html 从单元格转换为富文本答案

【问题标题】：Transforming a sub to a function in v.b.a that converts html from a cell to rich text将 sub 转换为 v.b.a 中的函数，将 html 从单元格转换为富文本
【发布时间】：2021-05-01 00:37:12
【问题描述】：

我已将运行 html 格式字符串的代码复制到 I.E. Web 浏览器将其转换为富文本，然后将其复制回运行代码的单元格中。我已经包含了下面的代码。

但是，我希望能够将此 sub 作为其他用户的功能运行，这样他们就不必访问开发人员选项卡。我一直在纠结如何将这个 sub 转换成一个函数，所以如果有人能帮助我，那就太好了。

Sub Sample()

    Dim Ie As Object
    
    Set Ie = CreateObject("InternetExplorer.Application")
    
    With Ie
        .Visible = False
        
        .Navigate "about:blank"
        
        .document.body.InnerHTML = Sheets("Sheet1").Range("A1").Value
        
        .ExecWB 17, 0: .ExecWB 12, 2
        ActiveSheet.Paste Destination:=Sheets("Sheet1").Range("A1")
        
        .Quit
    End With
End Sub

感谢所有回复。

例如，在单元格 A1 中，我有“ 这是 自定义文本”。我希望能够在单元格 A2 '=sample(A1)' 中写入，并将 A1 中的文本转换为格式化文本，即。 '这是自定义文本'由我包含的代码。单元格 A2 将包含转换后的文本。

【问题讨论】：

“将其作为格式化的富文本粘贴回该单元格”......我认为这作为 UDF 是不可行的。
@NicholasHunter 我相信Application.Caller 无关紧要，因为 UDF 无法修改调用它的单元格，但只能将值（无格式）返回到所述单元格。
@NicholasHunter no Application.Caller.Value = Sheets("Sheet1").Range("A1").Value 将不起作用，因为 Scott 在对您已删除答案的评论中已经指出。该函数应该返回值，即Sample = Sheets("Sheet1").Range("A1").Value，但这也无关紧要，因为UDF不能Paste。
@Jamesk112 不，UDF 无法复制/粘贴，也无法像您尝试的那样返回格式化文本。为此，您需要Sub。
UDF 不能改变任何单元格的值或格式，它只能返回一个值。输出单元格的格式是单独设置的。这需要保留一个 sub，但就像我说的那样，您可以为 sub 附加一个快捷方式，因此用户只需执行 ctrl-h 之类的操作即可从工作表中运行它。

标签： excel vba

【解决方案1】：

此 UDF 解决了问题中给出的用例。该函数使用正则表达式解析要加粗的文本，然后利用 Mark.R 几年前的code 将字符值转换为等效的 unicode 粗体字符值。此代码仅处理标记，但可以轻松扩展以处理 标记。

Option Explicit

Function EmboldenText(ByVal source As Range) As String

    Dim re As VBScript_RegExp_55.RegExp
    Dim m As VBScript_RegExp_55.Match
    Dim strIn As String
    Dim strout As String
    Dim start As Integer
    
    Set re = New VBScript_RegExp_55.RegExp
    re.Pattern = "<b>(.+?)</b>"
    re.Global = True
    
    strIn = source.Value
    strout = ""
    start = 1

    For Each m In re.Execute(strIn)
        strout = strout & Mid(strIn, start, m.FirstIndex - start + 1) & _
            Bold(m.SubMatches(0))
        start = m.FirstIndex + m.Length + 1
    Next m
    
    EmboldenText = strout & Mid(strIn, start)

End Function

如果您想尝试此解决方案，您需要将此库添加到您的参考文献中。

【讨论】：