Excel 更新 PowerPoint 演示文稿
Excel to update PowerPoint Presentation
我有一个演示文稿,我必须每周更新一次。我更新的信息是我从 Excel 枢轴 table 生成的一堆图像(从 Excel 复制并直接粘贴到 PowerPoint 上)。
今天我可以这样做:
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set PPTPrez =
objPPT.Presentations.Open("\network_folder\presentation.pptm")
Set pSlide = PPTPrez.Slides(2)
If pSlide.Shapes.Count <> 0 Then
ActiveWorkbook.Sheets("Pivot1").Range("A8:Z18").CopyPicture
pSlide.Shapes.Paste
EndIf
它工作完美...但我需要更多的控制和精确度...
我需要 select 幻灯片上的当前图片,将其删除并将新图片粘贴到同一位置...有些幻灯片有 3 张或更多图片...
我无法弄清楚如何正确地告诉 VBA 什么图像是什么并选择具有该图像正确信息的枢轴 table ...我什至不知道这是否可能...
但是我尝试过的另一种解决方案是如何指定幻灯片上图像的位置和尺寸...我可以在更新之前删除所有图像...在这种情况下,如何指定尺寸和定位?
谢谢!!!
Ps.: 抱歉我的英语不好
此示例(基于您的代码)可能会为您指明正确的方向。您需要知道 powerpoint 形状名称(您可以通过 VBA 或通过功能区 Home-Select-Selection Pane.
Option Explicit
Public Sub UpdateShapes()
Dim vPowerPoint As PowerPoint.Application
Dim vPresentation As Presentation
Dim vSlide As Slide
Dim vShapeName As String
Dim vShape, vNewShape
Set vPowerPoint = New PowerPoint.Application
vPowerPoint.Visible = True
' Open the powerpoint presentation
Set vPresentation = vPowerPoint.Presentations.Open("\network_folder\presentation.pptm")
' Set slide to be worked on
Set vSlide = vPresentation.Slides(2)
' Set shape to (for this example) "Picture 3"
vShapeName = "Picture 3"
Set vShape = vSlide.Shapes(vShapeName)
' Copy and paste new shape (picture) of range specified
ThisWorkbook.Sheets("Sheet1").Range("A6:B9").CopyPicture
Set vNewShape = vSlide.Shapes.Paste
' Align size and position of new shape to that of old shape
With vNewShape
.Width = vShape.Width
.Height = vShape.Height
.Left = vShape.Left
.Top = vShape.Top
End With
' Delete original shape, rename new shape to original so code works next replace cycle
vSlide.Shapes(vShapeName).Delete
vNewShape.Name = vShapeName
End Sub
我有一个演示文稿,我必须每周更新一次。我更新的信息是我从 Excel 枢轴 table 生成的一堆图像(从 Excel 复制并直接粘贴到 PowerPoint 上)。 今天我可以这样做:
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set PPTPrez =
objPPT.Presentations.Open("\network_folder\presentation.pptm")
Set pSlide = PPTPrez.Slides(2)
If pSlide.Shapes.Count <> 0 Then
ActiveWorkbook.Sheets("Pivot1").Range("A8:Z18").CopyPicture
pSlide.Shapes.Paste
EndIf
它工作完美...但我需要更多的控制和精确度... 我需要 select 幻灯片上的当前图片,将其删除并将新图片粘贴到同一位置...有些幻灯片有 3 张或更多图片... 我无法弄清楚如何正确地告诉 VBA 什么图像是什么并选择具有该图像正确信息的枢轴 table ...我什至不知道这是否可能... 但是我尝试过的另一种解决方案是如何指定幻灯片上图像的位置和尺寸...我可以在更新之前删除所有图像...在这种情况下,如何指定尺寸和定位?
谢谢!!!
Ps.: 抱歉我的英语不好
此示例(基于您的代码)可能会为您指明正确的方向。您需要知道 powerpoint 形状名称(您可以通过 VBA 或通过功能区 Home-Select-Selection Pane.
Option Explicit
Public Sub UpdateShapes()
Dim vPowerPoint As PowerPoint.Application
Dim vPresentation As Presentation
Dim vSlide As Slide
Dim vShapeName As String
Dim vShape, vNewShape
Set vPowerPoint = New PowerPoint.Application
vPowerPoint.Visible = True
' Open the powerpoint presentation
Set vPresentation = vPowerPoint.Presentations.Open("\network_folder\presentation.pptm")
' Set slide to be worked on
Set vSlide = vPresentation.Slides(2)
' Set shape to (for this example) "Picture 3"
vShapeName = "Picture 3"
Set vShape = vSlide.Shapes(vShapeName)
' Copy and paste new shape (picture) of range specified
ThisWorkbook.Sheets("Sheet1").Range("A6:B9").CopyPicture
Set vNewShape = vSlide.Shapes.Paste
' Align size and position of new shape to that of old shape
With vNewShape
.Width = vShape.Width
.Height = vShape.Height
.Left = vShape.Left
.Top = vShape.Top
End With
' Delete original shape, rename new shape to original so code works next replace cycle
vSlide.Shapes(vShapeName).Delete
vNewShape.Name = vShapeName
End Sub