将粗体字体替换为文本周围的 html 粗体标签

Question

我正在尝试创建 Excel VBA 代码来查找粗体文本并在找到的文本周围添加 html 粗体标记。

示例：
查找：“这个粗体字”和
替换为：“This <b>bold</b> word”（html标签和word都需要加粗）

注意：粗体文本在非粗体文本的单元格内，只应替换粗体文本。

我还需要换一种方式。意思是查找带有或不带有粗体字体的粗体标签 (<b></b>)，并删除标签并确保文本为粗体。

找到了this，看起来很接近，但我对ActiveDocument.Tables(1).Select 和.Wrap = wdFindStop 有疑问。

我还发现了this，它可能有助于查找/替换文本而不会丢失粗体格式，但不完全是我需要的。对于我想要做的事情来说，这可能有点矫枉过正。

我正在做一些事情。

Sub removeboldaddHtml()
    lastrow = Range("A1").End(xlDown).Row
    For i = 1 To lastrow
        msg = ""
        For j = 1 To Len(Cells(i, 1))
            If Range("A" & i).Characters(j, 1).Font.Bold = True Then
                msg = msg & Mid(Cells(i, 1), j, 1)
            End If
        Next j ' next character
        If msg <> "" Then
            Cells(i, "B").Value = "<b>" & msg & "</b>"
        End If
    Next i ' next row
End Sub

Answer 1

下面的代码相当粗糙、不优雅且耗费资源。但无论如何可能会有所帮助（对于您问题的第一部分）。只有当粗体是连续的时它才会起作用（它不会为 for 像 like 这样的东西起作用）。数据位于工作表“Sheet1”的 A 列（以下代码中只有第 1 到 3 行）。 已编辑，以粗体显示标签和标签之间的文本。

Private Sub CommandButton1_Click()
    Dim MyStringLength  As Integer
    Dim OriginalString As String
    Dim MyRow As Long
    Dim StartPos As Integer
    Dim EndPos As Integer


        For MyRow = 1 To 3 'Adjust to your row number
            StartPos = 0
            EndPos = 0
            MyStringLenght = Len(Worksheets("Sheet1").Cells(MyRow, 1))
            For i = 1 To MyStringLenght
                If Worksheets("Sheet1").Cells(MyRow, 1).Characters(i, 1).Font.Bold = True Then
                    If StartPos = 0 Then
                        StartPos = i
                    End If
                    EndPos = i
                End If
            Next
            OriginalString = Worksheets("Sheet1").Cells(MyRow, 1)
            Worksheets("Sheet1").Cells(MyRow, 2) = StartPos
            Worksheets("Sheet1").Cells(MyRow, 3) = EndPos
            Worksheets("Sheet1").Cells(MyRow, 4) = Left(OriginalString, StartPos - 1) & "<b>" & Mid(OriginalString, StartPos, EndPos - StartPos + 1) & "</b>" & Right(OriginalString, MyStringLenght - EndPos)
            Worksheets("Sheet1").Cells(MyRow, 4).Characters(StartPos, EndPos - StartPos + 7).Font.Bold = True
        Next
End Sub

Answer 2

添加标签示例：

Sub Tester()
    AddTags Range("A1")
End Sub

Sub AddTags(c As Range)

    Dim p As Long, isB As Boolean
    Do
        p = p + 1
        If p > Len(c.Value) Then Exit Do

        If c.Characters(p, 1).Font.Bold And Not isB Then
            'entering a bolded section
            c.Characters(p, 0).Insert "<b>"
            c.Characters(p, 3).Font.Bold = True
            isB = True
            p = p + 3 'skip the tag you just added
        ElseIf Not c.Characters(p, 1).Font.Bold And isB Then
            'leaving a bolded section
            c.Characters(p, 0).Insert "</b>"
            c.Characters(p, 4).Font.Bold = True
            isB = False
            p = p + 4 'skip the tag you just added
        End If
    Loop
    'close any open tag
    If isB Then c.Characters(p, 0).Insert "</b>"
End Sub