在 PowerPoint 中的 table 个单元格中查找文本并将 text/range 的格式更改为粗体或斜体

Question

请帮助将下面的代码修改为运行在 PowerPoint 中 table 的单元格内。

第 1 栏

第 1 行示例
第 2 行快速棕色（粗体）狐狸（/粗体）跳过（粗体）懒惰的狗（/粗体）。
第 2 行 (i) 下一行：敏捷的棕色狐狸跳过懒惰的狗。 (/i)
第 3 行结果
第 4 行敏捷的棕色 fox 跳过 over 懒狗。
第 4 行 下一行：敏捷的棕色狐狸跳过懒惰的狗。

代码：

Sub Htmlize()
    Dim oSld As Slide
    Dim oShp As Shape
    Dim oTxtRng As TextRange
    Dim openTag As TextRange
    Dim closeTag As TextRange
    Dim endRange As Long
    Dim startRange As Long

    For Each oSld In ActivePresentation.Slides
        For Each oShp In oSld.Shapes
            If oShp.HasTextFrame Then
                Set oTxtRng = oShp.TextFrame.TextRange
                Set openTag = oTxtRng.Find(FindWhat:="<i>", _
                    MatchCase:=False)
                Do While Not (openTag Is Nothing)
                    Set closeTag = oTxtRng.Find(FindWhat:="</i>", _
                        MatchCase:=False)
                    If closeTag Is Nothing Then
                        endRange = oTxtRng.Length
                    Else
                        endRange = closeTag.Start - 1
                        oTxtRng.Characters(closeTag.Start, _
                            closeTag.Length).Delete
                    End If
                    startRange = openTag.Start
                    oTxtRng.Characters(startRange, _
                        endRange - startRange + 1) _
                        .Font.Italic = True
                    oTxtRng.Characters(openTag.Start, _
                        openTag.Length).Delete
                    Set openTag = oTxtRng.Find(FindWhat:="<i>", _
                        MatchCase:=False)
                Loop
            End If
        Next oShp
    Next oSld

    For Each oSld In ActivePresentation.Slides
        For Each oShp In oSld.Shapes
            If oShp.HasTextFrame Then
                Set oTxtRng = oShp.TextFrame.TextRange
                Set openTag = oTxtRng.Find(FindWhat:="<bold>", _
                    MatchCase:=False)
                Do While Not (openTag Is Nothing)
                    Set closeTag = oTxtRng.Find(FindWhat:="</bold>", _
                        MatchCase:=False)
                    If closeTag Is Nothing Then
                        endRange = oTxtRng.Length
                    Else
                        endRange = closeTag.Start - 1
                        oTxtRng.Characters(closeTag.Start, _
                            closeTag.Length).Delete
                    End If
                    startRange = openTag.Start
                    oTxtRng.Characters(startRange, _
                        endRange - startRange + 1) _
                        .Font.Italic = True
                    oTxtRng.Characters(openTag.Start, _
                        openTag.Length).Delete
                    Set openTag = oTxtRng.Find(FindWhat:="<bold>", _
                        MatchCase:=False)
                Loop
            End If
        Next oShp
    Next oSld

End Sub

Answer 1

正如我在评论中所说，其中有很多主题 -- 这段代码应该可以帮助您入门。我把所有的都放在评论里

Sub Htmlize()
    Dim oSld As Slide
    Dim oShp As Shape
    Dim oTxtRng As TextRange
    Dim openTag As TextRange
    Dim closeTag As TextRange
    Dim endRange As Long
    Dim startRange As Long


    'You have to work with tables
    'You speak only of one Column, so I assume 1 Column
    Dim oTbl As Table
    Dim lRow As Long


    For Each oSld In ActivePresentation.Slides


        For Each oShp In oSld.Shapes

            'If oShp.HasTextFrame Then
            'You have to use Tables instead
            If oShp.HasTable Then
                Set oTbl = oShp.Table
                'with this you set the table


                'Now you have to iterate through the Rows (and of course through columns if that is necessary. I will assume here that it is only 1 column)
                For lRow = 1 To oTbl.Rows.Count




                    'Set oTxtRng = oShp.TextFrame.TextRange
                    'This has to be changed now to the content of the cell:
                    Set oTxtRng = oTbl.Cell(lRow, 1).Shape.TextFrame.TextRange


                    'Here is your original code
                    'I changed the < to ( so that it works
                    'This code will do the Italic work for you -- now you have to adapt it for bold

                    Set openTag = oTxtRng.Find(FindWhat:="(i)", _
                        MatchCase:=False)
                    Do While Not (openTag Is Nothing)
                        Set closeTag = oTxtRng.Find(FindWhat:="(/i)", _
                            MatchCase:=False)
                        If closeTag Is Nothing Then
                            endRange = oTxtRng.Length
                        Else
                            endRange = closeTag.Start - 1
                            oTxtRng.Characters(closeTag.Start, _
                                closeTag.Length).Delete
                        End If
                        startRange = openTag.Start
                        oTxtRng.Characters(startRange, _
                            endRange - startRange + 1) _
                            .Font.Italic = True
                        oTxtRng.Characters(openTag.Start, _
                            openTag.Length).Delete
                        Set openTag = oTxtRng.Find(FindWhat:="(i)", _
                            MatchCase:=False)
                    Loop



                    'Now you go through the rows
                Next 'lRow

            End If
        Next oShp

    Next oSld

    'I Don't know why you go through this twice -- makes the work just longer. You could do this in one sweep while you are going throught the tables already.
    'But I guess you know why you do it that way

    'You have to adapt the upper part for this one here too


    For Each oSld In ActivePresentation.Slides

        For Each oShp In oSld.Shapes
            If oShp.HasTextFrame Then
                Set oTxtRng = oShp.TextFrame.TextRange
                Set openTag = oTxtRng.Find(FindWhat:="(bold)", _
                    MatchCase:=False)
                Do While Not (openTag Is Nothing)
                    Set closeTag = oTxtRng.Find(FindWhat:="(/bold)", _
                        MatchCase:=False)
                    If closeTag Is Nothing Then
                        endRange = oTxtRng.Length
                    Else
                        endRange = closeTag.Start - 1
                        oTxtRng.Characters(closeTag.Start, _
                            closeTag.Length).Delete
                    End If
                    startRange = openTag.Start
                    oTxtRng.Characters(startRange, _
                        endRange - startRange + 1) _
                        .Font.Bold = True
                    oTxtRng.Characters(openTag.Start, _
                        openTag.Length).Delete
                    Set openTag = oTxtRng.Find(FindWhat:="(bold)", _
                        MatchCase:=False)
                Loop
            End If
        Next oShp

    Next oSld

End Sub

在 PowerPoint 中的 table 个单元格中查找文本并将 text/range 的格式更改为粗体或斜体

find text and change format of text/range to bold or italic within table cells in powerpoint

powerpoint

vba