Выбор формы через поле ввода для изменения шрифта

Question

Я пытаюсь изменить шрифт введенного пользователем имени Shape, однако при запуске кода ничего не происходит. Куда я иду не так, пожалуйста? Спасибо, Джей

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

Answer 1

Вы можете сделать это без 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