【发布时间】:2018-02-14 10:43:57
【问题描述】:
我需要将一些图片从 Excel(图片位于同一文件的不同文件夹中)复制到 PowerPoint,为现有 PowerPoint 文件中的每张图片添加一张幻灯片(文件名是 TBD_ppt_WRK,里面已经有 2 张幻灯片必须保留)。 我需要从 Excel 运行宏。我使用的宏是:
Sub TBD_GENERATE_PPW()
' OPEN FILE TBD_ppt_WRK WHERE COPY THE PICTURES FROM EXCEL
Dim pp As Object
Set pp = CreateObject("PowerPoint.Application")
pp.Visible = True
pp.Presentations.Open ("C:\ Desktop\ ppt_TBD_WRK.ppt")
‘C:\ Desktop\ ppt_TBD_WRK.ppt is path & name of the PPW file where to add the slides
'Step 1: Declare variables
Dim ppPres As Object
Dim ppSlide As Object
Dim xlwksht As Worksheet
Dim MyRange As String
'Step 2:
Set pp = New PowerPoint.Application
Set ppPres = pp.ActivePresentation
pp.Visible = True
'Step 3: Set the ranges for your data and title
MyRange = "B2:S40"
'Step 4: Start the loop through each worksheet
For Each xlwksht In ActiveWorkbook.Worksheets
xlwksht.Select
Application.Wait (Now + TimeValue("0:00:1"))
'Step 5: Copy the range as picture
xlwksht.Range(MyRange).CopyPicture _
Appearance:=xlScreen, Format:=xlPicture
'Step 6: Count slides and add new blank slide as next available slide number
'(the number 12 represents the enumeration for a Blank Slide)
Slidecount = ppPres.Slides.Count
Set ppSlide = ppPres.Slides.Add(Slidecount + 1, 12)
ppSlide.Select
'Step 7: Paste the picture and adjust its position
ppSlide.Shapes.Paste.Select ‘ => THIS IS WHERE MACRO GOES IN ERROR SEE BELOW
pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
pp.ActiveWindow.Selection.ShapeRange.Top = 75
pp.ActiveWindow.Selection.ShapeRange.Left = 125
pp.ActiveWindow.Selection.ShapeRange.Width = 550
'Step 8: Add the title to the slide then move to next worksheet
Next xlwksht
'Step 9: Saves the Powerpoint file updated with the name TDB pat_PAG_.ppt and closes it the Powerpoint file updated
ppPres.SaveAs "C:\Users\392710\Desktop\MENSILI_WRK\TDB patrimoni_PAG_.ppt", 1
ppPres.Close
'Step 10: Memory Cleanup
pp.Activate
Set ppSlide = Nothing
Set ppPres = Nothing
Set pp = Nothing
END SUB
奇怪的是,当我在调试(F8)中逐步运行宏时,它可以完美运行,但是当我直接从 Excel 宏(宏/视图/运行)运行它时,它就不再起作用了。它在添加到 ppw 的第一张幻灯片中复制第一张图片后停止(参见代码中的注释)。
错误信息是:
运行时错误“-2147188160 (80048240)”ShapeRange.Select:无效请求。要选择一个形状,它的视图必须处于活动状态。
你能帮帮我吗?
【问题讨论】: