найти текст и изменить формат текста / диапазона на полужирный или итальянский c в ячейках таблицы в PowerPoint

Question

Помогите изменить приведенный ниже код, чтобы он запускался в ячейках таблицы в PowerPoint.

Столбец 1

Пример 1 строки
Строка 2 Быстрая коричневая (жирная) лиса (/ жирный) перепрыгивает (жирный) через (/ жирный) ленивую собаку.
Ряд 2 (i) Следующая строка: Быстрая коричневая лисица перепрыгивает через ленивую собаку. (/ i)
Ряд 3 Результат
Ряд 4 Быстрая коричневая лиса прыгает через ленивая собака.
Ряд 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