通过输入框选择形状来改变字体
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
我正在尝试更改用户输入的形状名称的字体,但是当我 运行 代码时没有任何反应。请问我哪里错了?谢谢杰
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