如何在PowerPoint中更改子字符串的字体？答案

【问题标题】：How to change font of a substring in powerpoint?如何在PowerPoint中更改子字符串的字体？
【发布时间】：2020-07-03 18:47:46
【问题描述】：

我想将我的 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

这可以识别每个数字但如何更改其字体？

【问题讨论】：

标签： vbscript powerpoint powerpoint-2013

【解决方案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

【讨论】：