通过输入框选择形状来改变字体

Choosing Shape via Input Box to change font

我正在尝试更改用户输入的形状名称的字体,但是当我 运行 代码时没有任何反应。请问我哪里错了?谢谢杰

Sub Button3()

    Dim bpFontName As String
    Dim bpSize
    Dim bpItem As String

    bpFontName = InputBox("Please enter font", "font type", "Calibri")
        bpSize = InputBox("Please enter font size", "fontsize", "12")
        bpItem = InputBox("Please enter the shape name", "shapename", "TextBox 1")

    With ActivePresentation
        For Each Slide In .Slides
          On Error Resume Next
            For Each Shape In Slide.Shapes
                With Slide.Shapes("bpItem")
                    If .HasTextFrame Then
                        If .TextFrame.HasText Then
                            .TextFrame.TextRange.Font.Name = bpFontName
                            .TextFrame.TextRange.Font.Size = bpSize
                              If Err.Number = -2147188160 Then GoTo SkipSlide
                        End If
                    End If
                End With

            Next
        Next
    End With

SkipSlide:
    Err.Number = 0
ActivePresentation.SlideShowWindow.View.Next


End Sub

您可以在没有 On Error Resume Next 的情况下执行此操作:

Sub Button3()

    Dim bpFontName As String
    Dim bpSize
    Dim bpItem As String

    bpFontName = InputBox("Please enter font", "font type", "Calibri")
        bpSize = InputBox("Please enter font size", "fontsize", "12")
        bpItem = InputBox("Please enter the shape name", "shapename", "TextBox 1")


    For Each Slide In ActivePresentation.Slides

        For Each Shape In Slide.Shapes
            If Shape.Name = bpItem Then
                If .HasTextFrame Then
                    If .TextFrame.HasText Then
                        .TextFrame.TextRange.Font.Name = bpFontName
                        .TextFrame.TextRange.Font.Size = bpSize

                    End If 'any text
                End If     'has text frame
            End If         'name matches
        Next 'shape

    Next 'slide

End Sub