如何在powerpoint中更改子字符串的字体？

Question

我想将我的powerpoint演示文稿中的每个数字都改为Times New Roman。我找到了更改整个文本框字体的代码，但我想更改数字的字体。

我有一个PowerPoint宏VBScript：

Sub use_regex()
    Dim regX As Object
    Dim osld As Slide
    Dim oshp As Shape
    Dim strInput As String
    Dim b_found As Boolean
    Dim iRow As Integer
    Dim iCol As Integer

    Set regX = CreateObject("vbscript.regexp")
    With regX
        .Global = True
        .Pattern = "(\d)"
    End With
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            If oshp.HasTable Then
                For iRow = 1 To oshp.Table.Rows.Count
                    For iCol = 1 To oshp.Table.Columns.Count
                        strInput = oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Text
                        b_found = regX.Test(strInput)
                        If b_found = True Then
                            strInput = regX.Replace(strInput, "$1")
                            oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange = strInput
                        End If
                    Next iCol
                Next iRow
            Else
                If oshp.HasTextFrame Then
                    If oshp.TextFrame.HasText Then
                        strInput = oshp.TextFrame.TextRange.Text
                        b_found = regX.Test(strInput)
                        If b_found = True Then
                            strInput = regX.Replace(strInput, "$1")
                            oshp.TextFrame.TextRange = strInput
                        End If
                    End If
                End If
            End If
        Next oshp
    Next osld
    Set regX = Nothing
End Sub

来源：http://www.pptalchemy.co.uk/PowerPoint_RegEx.html

这能够识别每个数字，但如何更改其字体？

Answer 1

我终于做到了。这是代码：

Sub use_regex()
    Dim regX As Object
    Dim osld As Slide
    Dim oshp As Shape
    Dim strInput As String
    Dim b_found As Boolean
    Dim iRow As Integer
    Dim iCol As Integer

    Set regX = CreateObject("vbscript.regexp")
    With regX
        .Global = True
        .Pattern = "(\d)"
    End With
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            If oshp.HasTable Then
                For iRow = 1 To oshp.Table.Rows.Count
                    For iCol = 1 To oshp.Table.Columns.Count
                        strInput = oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Text
                        b_found = regX.Test(strInput)
                        If b_found = True Then

                             Set myMatches = regX.Execute(strInput)
                             For Each myMatch In myMatches
                            oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Characters(myMatch.FirstIndex + 1, myMatch.Length).Characters.Font.Name = "Times New Roman"
                            Next
                        End If
                    Next iCol
                Next iRow
            Else
                If oshp.HasTextFrame Then
                    If oshp.TextFrame.HasText Then
                        strInput = oshp.TextFrame.TextRange.Text
                        b_found = regX.Test(strInput)
                        If b_found = True Then

                            Set myMatches = regX.Execute(strInput)
                                For Each myMatch In myMatches
                                    oshp.TextFrame.TextRange.Characters(myMatch.FirstIndex + 1, myMatch.Length).Characters.Font.Name = "Times New Roman"
                                Next

                        End If
                    End If
                End If
            End If
        Next oshp
    Next osld
    Set regX = Nothing
End Sub