如何在PowerPoint VBA中检查每个字符是数字还是字符并相应地更改其字体？

Question

我需要查看所有字符并检查它们是数字还是文本项。如果它们是任何一种，我需要相应地更改它们的字体。我已经设法使用一些内置函数在excel vba中执行此操作。但在powerpoint中似乎不太可能。

它相当原始，但确实有效。然而，奇怪的是，有些部分得到了妥善完成，有些部分没有。我无法弄清楚。

我使用过这段代码：

Sub FontChange()

Dim sld As Slide
Dim shp As Shape
Dim foundText As Variant
Dim findNumber As Variant
Dim findCharacter As Variant
Dim x As Long
Dim y As Long
'Dim i As Integer
'Dim j As Character

findNumber = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
findCharacter = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
    If shp.HasTextFrame Then  ' Not all shapes do
        If shp.TextFrame.HasText Then  ' the shape may contain no text
            For x = LBound(findNumber) To UBound(findNumber)
              Set foundText = shp.TextFrame.TextRange.Find(FindWhat:=findNumber(x))
                 Do While Not (foundText Is Nothing)
                     With foundText
                      .Font.Size = 18
                      .Font.Name = "Meta-Normal"
                      '.Bold = False
                      '.Color.RGB = RGB(255, 127, 255)
                     Set foundText = _
                        shp.TextFrame.TextRange.Find(FindWhat:="findNumber(x)", _
                        After:=.Start + .Length - 1)
                    End With
                 Loop
              Next x
        End If
    End If
    Next shp
Next sld
For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
    If shp.HasTextFrame Then  ' Not all shapes do
        If shp.TextFrame.HasText Then  ' the shape may contain no text
            For y = LBound(findCharacter) To UBound(findCharacter)
              Set foundText = shp.TextFrame.TextRange.Find(FindWhat:=findCharacter(y))
                 Do While Not (foundText Is Nothing)
                     With foundText
                      .Font.Size = 18
                      .Font.Name = "Neo Sans Pro Light"
                      '.Bold = False
                      '.Color.RGB = RGB(255, 127, 255)
                     Set foundText = _
                        shp.TextFrame.TextRange.Find(FindWhat:="findCharacter(y)", _
                        After:=.Start + .Length - 1)
                    End With
                 Loop
              Next y
        End If
    End If
    Next shp
Next sld
End Sub