PowerPoint VBA 向每张幻灯片添加图像
PowerPoint VBA adding image to every slide
我正在编写一个简单的宏来更改字体并为 power point 中的每张幻灯片添加徽标。
问题是每张幻灯片上的字体都在更新,但图像只粘贴在一张幻灯片上。 - 所以我最终在一张幻灯片上有 30 张图像彼此重叠(不是我需要的每张幻灯片上有 1 张图像)
我有以下内容:
Sub InsertLogoOnEveryPage()
Dim sld As Slide
Dim shp As Shape
Dim sFontName As String
Dim oTop As Integer
' font:
sFontName = "Times"
For Each sld In ActivePresentation.Slides
Debug.Print sld.Name
'Insert logo.
ActiveWindow.Selection.SlideRange.Shapes.AddPicture( _
FileName:="PATH\Logo_RGB.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=60, Top:=oTop, _
Width:=330, Height:=330).Select
For Each shp In sld.Shapes
With shp
If .HasTextFrame Then
If .TextFrame.HasText Then
.TextFrame.TextRange.Font.Name = sFontName
End If
End If
End With
Next shp
oTop = oTop + 10
Next sld
End Sub
任何解决此问题的帮助都很棒,谢谢!
您是否考虑过使用 Masters?母版将允许您为使用该母版的所有幻灯片定义字体和图像。
2 件事:
关于您的代码: 尽量避免使用 .Select
和 Selection
ActiveWindow.Selection.SlideRange.Shapes.AddPicture
应该是 sld.Shapes.AddPicture
ActiveWindow
只会是您的 PPT 应用程序中可见的幻灯片。
关于想法:
您应该转到 View
菜单,Slide Master
并编辑您使用的默认布局以避免使用某些代码! ;)
Sub InsertLogoOnEveryPage()
Dim sld As Slide
Dim shp As Shape
Dim sFontName As String
Dim oTop As Single
' font:
sFontName = "Times"
For Each sld In ActivePresentation.Slides
Debug.Print sld.Name
'Insert logo.
sld.Shapes.AddPicture FileName:="C:\Users\R3uKH2\Desktop\Dive zones.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=60, Top:=oTop, _
Width:=330, Height:=330
For Each shp In sld.Shapes
With shp
If .HasTextFrame Then
If .TextFrame.HasText Then
.TextFrame.TextRange.Font.Name = sFontName
End If
End If
End With
Next shp
oTop = oTop + 10
Next sld
End Sub
我正在编写一个简单的宏来更改字体并为 power point 中的每张幻灯片添加徽标。
问题是每张幻灯片上的字体都在更新,但图像只粘贴在一张幻灯片上。 - 所以我最终在一张幻灯片上有 30 张图像彼此重叠(不是我需要的每张幻灯片上有 1 张图像)
我有以下内容:
Sub InsertLogoOnEveryPage()
Dim sld As Slide
Dim shp As Shape
Dim sFontName As String
Dim oTop As Integer
' font:
sFontName = "Times"
For Each sld In ActivePresentation.Slides
Debug.Print sld.Name
'Insert logo.
ActiveWindow.Selection.SlideRange.Shapes.AddPicture( _
FileName:="PATH\Logo_RGB.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=60, Top:=oTop, _
Width:=330, Height:=330).Select
For Each shp In sld.Shapes
With shp
If .HasTextFrame Then
If .TextFrame.HasText Then
.TextFrame.TextRange.Font.Name = sFontName
End If
End If
End With
Next shp
oTop = oTop + 10
Next sld
End Sub
任何解决此问题的帮助都很棒,谢谢!
您是否考虑过使用 Masters?母版将允许您为使用该母版的所有幻灯片定义字体和图像。
2 件事:
关于您的代码: 尽量避免使用 .Select
和 Selection
ActiveWindow.Selection.SlideRange.Shapes.AddPicture
应该是 sld.Shapes.AddPicture
ActiveWindow
只会是您的 PPT 应用程序中可见的幻灯片。
关于想法:
您应该转到 View
菜单,Slide Master
并编辑您使用的默认布局以避免使用某些代码! ;)
Sub InsertLogoOnEveryPage()
Dim sld As Slide
Dim shp As Shape
Dim sFontName As String
Dim oTop As Single
' font:
sFontName = "Times"
For Each sld In ActivePresentation.Slides
Debug.Print sld.Name
'Insert logo.
sld.Shapes.AddPicture FileName:="C:\Users\R3uKH2\Desktop\Dive zones.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=60, Top:=oTop, _
Width:=330, Height:=330
For Each shp In sld.Shapes
With shp
If .HasTextFrame Then
If .TextFrame.HasText Then
.TextFrame.TextRange.Font.Name = sFontName
End If
End If
End With
Next shp
oTop = oTop + 10
Next sld
End Sub