파워 포인트에서 부분 문자열의 글꼴을 변경하는 방법은 무엇입니까?

Question

내 파워 포인트 프레젠테이션의 모든 자릿수를 Times New Roman으로 변경하고 싶습니다. 전체 텍스트 상자의 글꼴을 변경하는 코드를 찾았으나 숫자의 글꼴 만 변경하고 싶습니다.

나는 파워 포인트 매크로의 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