在 PowerPoint 演示文稿中调整/定位形状
Resize/ position shapes in PowerPoint presentation
我有旧代码,我正在将其重新用于更一般的用途。
我有一个 PowerPoint 演示文稿,我想将特定的图像文件粘贴到其中,创建一张新幻灯片,然后重复,直到完成 A 列中的所有变量名称。
它在特定文件位置找到图像名称,根据变量名称值的左侧、变量名称值(A 列)和变量名称值的右侧构建名称。前任。 ("Device" "23" "for generic product line").
找到这张图片名称后,它会获取该图片并将其插入幻灯片,调整大小并将其定位到左侧,然后找到另一张比较图像,将其放在同一张幻灯片上并调整大小并将其定位到右侧.
调整大小和定位不再正常工作。似乎图像没有被视为形状。我知道第一张图片是之前实验的形状 (2),因为幻灯片上有一些剪贴画算作形状。出于同样的原因,我然后将 shape(3) 设为图像 2。
Sub Export_To_PowerPoint_JAH()
' Keyboard Shortcut: Ctrl+Shift+M
Dim Shape1 As PowerPoint.Shape
Dim Shape2 As PowerPoint.Shape
Dim objSlide As Slide
Dim New_Slide As Slide
Dim pptLayout As CustomLayout
Dim PP As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation
'Create a PP application and make it visible
Set PP = New PowerPoint.Application
PP.Visible = msoCTrue
'Open the presentation you wish to copy to
'Opens the Template
Set PPpres = PP.Presentations.Open("A file path name to a template")
i = 7
Pre_Left = Range("H2")
Pre_Right = Range("H4")
Post_Left = Range("K2")
Post_Right2 = Range("K4")
Do
Set objSlide = PPpres.Slides(i - 5)
Set Title = PPpres.Slides(i - 5)
If Cells(i, 1) = "" Then
Exit Do
Else: End If
Variable_Name = Cells(i, 1)
'Searches Image Bank Folder for pre and post file names
If Not Range("H2") = "" Then
Image_Name_Pre = Pre_Left & " " & Variable_Name & " " & Pre_Right
Else
Image_Name_Pre = Variable_Name & " " & Pre_Right
End If
If Not Range("K2") = "" Then
Image_Name_Post = Post_Left & " " & Variable_Name & " " & Post_Right2
Else
Image_Name_Post = Variable_Name & " " & Post_Right2
End If
Set Shape1 = objSlide.Shapes.AddPicture(Range("B5") & Image_Name_Pre, msoCTrue, msoCTrue, 100, 100)
objSlide.Shapes.Item(2).Width = 300
objSlide.Shapes.Item(2).Height = 400
objSlide.Shapes.Item(2).Top = 140
objSlide.Shapes.Item(2).Left = 90
Set Shape2 = objSlide.Shapes.AddPicture(Range("B5") & Image_Name_Post, msoCTrue, msoCTrue, 100, 100)
objSlide.Shapes.Item(3).Width = 300
objSlide.Shapes.Item(3).Height = 400
objSlide.Shapes.Item(3).Top = 140
objSlide.Shapes.Item(3).Left = 500
Title.Shapes.Title.TextFrame.TextRange.Text = Cells(i, 3) & " Pre (Left) : " & Cells(i, 3) & " Post (Right) Offset=" & Cells(i, 4)
'Create new slide
Set New_Slide = PPpres.Slides.Add(PPpres.Slides.Count + 1, PpSlideLayout.ppLayoutObject)
'ActivePresentation.Slides.Add Index:=ActivePresentation.Slides.Count + 1, Layout:=ppLayoutCustom
i = i + 1
Loop
End Sub
假设您所追求的形状将是幻灯片上的第 n 个形状不是一个好主意,在您的情况下,没有必要这样做。这个:
Set Shape1 = objSlide.Shapes.AddPicture(Range("B5") & Image_Name_Pre, msoCTrue, msoCTrue, 100, 100)
在变量 Shape1 中为您提供新插入图像的引用,因此您可以这样做:
With Shape1
.Width = 300
.Height = 400
.Top = 140
.Left = 90
End With
Shape2 同样如此。
另外,你这样做:
Set Title = PPpres.Slides(i - 5)
这里有两个问题:
1) 您还没有声明变量 Title,并且
2) 使用 object/method/property 名称作为变量名不是好的做法。
改为:
Dim oTitle as Slide
Set oTitle = PPpres.Slides(i - 5)
我有旧代码,我正在将其重新用于更一般的用途。
我有一个 PowerPoint 演示文稿,我想将特定的图像文件粘贴到其中,创建一张新幻灯片,然后重复,直到完成 A 列中的所有变量名称。
它在特定文件位置找到图像名称,根据变量名称值的左侧、变量名称值(A 列)和变量名称值的右侧构建名称。前任。 ("Device" "23" "for generic product line").
找到这张图片名称后,它会获取该图片并将其插入幻灯片,调整大小并将其定位到左侧,然后找到另一张比较图像,将其放在同一张幻灯片上并调整大小并将其定位到右侧.
调整大小和定位不再正常工作。似乎图像没有被视为形状。我知道第一张图片是之前实验的形状 (2),因为幻灯片上有一些剪贴画算作形状。出于同样的原因,我然后将 shape(3) 设为图像 2。
Sub Export_To_PowerPoint_JAH()
' Keyboard Shortcut: Ctrl+Shift+M
Dim Shape1 As PowerPoint.Shape
Dim Shape2 As PowerPoint.Shape
Dim objSlide As Slide
Dim New_Slide As Slide
Dim pptLayout As CustomLayout
Dim PP As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation
'Create a PP application and make it visible
Set PP = New PowerPoint.Application
PP.Visible = msoCTrue
'Open the presentation you wish to copy to
'Opens the Template
Set PPpres = PP.Presentations.Open("A file path name to a template")
i = 7
Pre_Left = Range("H2")
Pre_Right = Range("H4")
Post_Left = Range("K2")
Post_Right2 = Range("K4")
Do
Set objSlide = PPpres.Slides(i - 5)
Set Title = PPpres.Slides(i - 5)
If Cells(i, 1) = "" Then
Exit Do
Else: End If
Variable_Name = Cells(i, 1)
'Searches Image Bank Folder for pre and post file names
If Not Range("H2") = "" Then
Image_Name_Pre = Pre_Left & " " & Variable_Name & " " & Pre_Right
Else
Image_Name_Pre = Variable_Name & " " & Pre_Right
End If
If Not Range("K2") = "" Then
Image_Name_Post = Post_Left & " " & Variable_Name & " " & Post_Right2
Else
Image_Name_Post = Variable_Name & " " & Post_Right2
End If
Set Shape1 = objSlide.Shapes.AddPicture(Range("B5") & Image_Name_Pre, msoCTrue, msoCTrue, 100, 100)
objSlide.Shapes.Item(2).Width = 300
objSlide.Shapes.Item(2).Height = 400
objSlide.Shapes.Item(2).Top = 140
objSlide.Shapes.Item(2).Left = 90
Set Shape2 = objSlide.Shapes.AddPicture(Range("B5") & Image_Name_Post, msoCTrue, msoCTrue, 100, 100)
objSlide.Shapes.Item(3).Width = 300
objSlide.Shapes.Item(3).Height = 400
objSlide.Shapes.Item(3).Top = 140
objSlide.Shapes.Item(3).Left = 500
Title.Shapes.Title.TextFrame.TextRange.Text = Cells(i, 3) & " Pre (Left) : " & Cells(i, 3) & " Post (Right) Offset=" & Cells(i, 4)
'Create new slide
Set New_Slide = PPpres.Slides.Add(PPpres.Slides.Count + 1, PpSlideLayout.ppLayoutObject)
'ActivePresentation.Slides.Add Index:=ActivePresentation.Slides.Count + 1, Layout:=ppLayoutCustom
i = i + 1
Loop
End Sub
假设您所追求的形状将是幻灯片上的第 n 个形状不是一个好主意,在您的情况下,没有必要这样做。这个:
Set Shape1 = objSlide.Shapes.AddPicture(Range("B5") & Image_Name_Pre, msoCTrue, msoCTrue, 100, 100)
在变量 Shape1 中为您提供新插入图像的引用,因此您可以这样做:
With Shape1
.Width = 300
.Height = 400
.Top = 140
.Left = 90
End With
Shape2 同样如此。
另外,你这样做:
Set Title = PPpres.Slides(i - 5)
这里有两个问题:
1) 您还没有声明变量 Title,并且
2) 使用 object/method/property 名称作为变量名不是好的做法。
改为:
Dim oTitle as Slide
Set oTitle = PPpres.Slides(i - 5)