用文本周圍的html粗體標簽替換粗體

Question

我正在嘗試創建Excel VBA代碼以查找粗體文本，並在找到的文本周圍添加html粗體標簽。

例：
查找：“此粗體字”和
替換為：“此<b>bold</b>字”（html標記和字都必須為粗體）

注意：粗體字在包含非粗體字的單元格內，並且僅應替換粗體字。

我還需要轉換另一種方式。 含義查找帶有或不帶有粗體的粗體標簽（ <b></b> ），並刪除標簽並確保文本為粗體。

發現這似乎很接近，但是我對ActiveDocument.Tables(1).Select和.Wrap = wdFindStop 。

我還發現， 這可能有助於查找/替換文本而不會丟失粗體格式，但並不是我真正需要的。 對於我想要做的事情，這可能太過分了。

我正在做一些事情。

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

后續代碼相當粗糙，繁瑣且占用資源。 但無論如何可能會有所幫助（對於您問題的第一部分）。 如果大膽的是連續的（它不會 像這樣工作）它才有效。 數據在工作表“ 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