[英]Excel vba to copy slides to an existing powerpoint presentation
I need to copy some pictures from Excel (the pictures are in different folders within the same file) to PowerPoint, adding a slide for every picture in an already existing PowerPoint file (the file name is TBD_ppt_WRK which has already 2 slides inside that must be kept). 我需要将Excel中的某些图片(这些图片位于同一文件中的不同文件夹中)复制到PowerPoint,为现有PowerPoint文件中的每张图片添加一张幻灯片(文件名为TBD_ppt_WRK,其中必须已经包含2张幻灯片)保持)。 I need to run the macro from Excel.
我需要从Excel运行宏。 The macro I'm using is:
我正在使用的宏是:
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
The strange thing is that the macro works perfectly when I run it in debug (F8) step by step, but it doesn't work anymore when I run it directly from the Excel Macro (Macro/View/Run). 奇怪的是,当我逐步在调试(F8)中运行该宏时,它可以完美运行,但是当我直接从Excel宏(宏/视图/运行)中运行它时,该宏将不再起作用。 It stops after the first picture has been copied in the first slide added to ppw (see the comment in the code).
在将第一张图片复制到添加到ppw的第一张幻灯片中后,它将停止(请参阅代码中的注释)。
The error message is: 错误消息是:
Run time error '-2147188160 (80048240)' ShapeRange.Select : Invalid request.
运行时错误'-2147188160(80048240)'ShapeRange.Select:无效的请求。 To select a shape, its view must be active.
要选择形状,其视图必须处于活动状态。
Can you help me please? 你能帮我吗?
Shape must be activated to perform any operation on it 必须激活图形才能对其执行任何操作
Below is the code that I have created to copy charts from Excel and paste into existing PPT template (in picture format) 下面是我创建的用于从Excel复制图表并将其粘贴到现有PPT模板(以图片格式)中的代码
You can also use for loop to go through charts in each sheet. 您还可以使用for循环浏览每张工作表中的图表。 I could not do it beacuse chart names were not same in each sheet
我无法执行此操作,因为每个工作表中的图表名称都不相同
Sub create_ppt()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb1 As Workbook
Dim wb1_path As String
Dim ppt_app_1 As Object
Dim ppt_1 As PowerPoint.Presentation
Dim ppt_sld As PowerPoint.Slide
Dim ppt_path As String
Dim month_name As String
Dim year_num As String
Dim month_full As String
Dim year_full As String
month_name = Range("Output!C5")
year_num = Range("Output!C8")
month_full = Range("Output!C9")
year_full = Range("Output!C7")
''opening target excel
wb1_path = ThisWorkbook.Path & "\Report\Acquisition_Summary_" & month_name & "_" & year_num & ".xlsx"
Set wb1 = Workbooks.Open(wb1_path)
''opening target ppt
Set ppt_app_1 = CreateObject("Powerpoint.Application")
Set ppt_1 = ppt_app_1.Presentations.Open(ThisWorkbook.Path & "\Template.pptx")
''slide 1
ppt_1.Slides(1).Shapes(2).TextFrame.TextRange.Text = "Small Business" & vbCrLf & "( " & month_full & " - " & year_full & " )"
''slide 2
wb1.Sheets("Sheet1").Select
Set ppt_sld = ppt_1.Slides(2)
ActiveSheet.ChartObjects("Chart 33").Activate
ActiveSheet.Shapes("Chart 33").Height = 198
ActiveSheet.Shapes("Chart 33").Width = 500.4
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 7.2
ppt_sld.Shapes(3).Top = 59.76 ''1 inch = 72 macro units
ActiveSheet.ChartObjects("Chart 19").Activate
ActiveSheet.Shapes("Chart 19").Height = 198
ActiveSheet.Shapes("Chart 19").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 516.24
ppt_sld.Shapes(4).Top = 59.76
ActiveSheet.ChartObjects("Chart 20").Activate
ActiveSheet.Shapes("Chart 20").Height = 198
ActiveSheet.Shapes("Chart 20").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(5).Left = 516.24
ppt_sld.Shapes(5).Top = 264.24
ActiveSheet.ChartObjects("Chart 15").Activate
ActiveSheet.Shapes("Chart 15").Height = 198
ActiveSheet.Shapes("Chart 15").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(6).Left = 7.2
ppt_sld.Shapes(6).Top = 264.24
ActiveSheet.ChartObjects("Chart 26").Activate
ActiveSheet.Shapes("Chart 26").Height = 198
ActiveSheet.Shapes("Chart 26").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(7).Left = 261.36
ppt_sld.Shapes(7).Top = 264.24
''slide 3
Set ppt_sld = ppt_1.Slides(3)
ActiveSheet.ChartObjects("Chart 14").Activate
ActiveSheet.Shapes("Chart 14").Height = 198
ActiveSheet.Shapes("Chart 14").Width = 500.4
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 7.2
ppt_sld.Shapes(3).Top = 59.76 ''1 inch = 72 macro units
ActiveSheet.ChartObjects("Chart 23").Activate
ActiveSheet.Shapes("Chart 23").Height = 198
ActiveSheet.Shapes("Chart 23").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 516.24
ppt_sld.Shapes(4).Top = 59.76
ActiveSheet.ChartObjects("Chart 25").Activate
ActiveSheet.Shapes("Chart 25").Height = 198
ActiveSheet.Shapes("Chart 25").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(5).Left = 516.24
ppt_sld.Shapes(5).Top = 264.24
ActiveSheet.ChartObjects("Chart 27").Activate
ActiveSheet.Shapes("Chart 27").Height = 198
ActiveSheet.Shapes("Chart 27").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(6).Left = 7.2
ppt_sld.Shapes(6).Top = 264.24
ActiveSheet.ChartObjects("Chart 28").Activate
ActiveSheet.Shapes("Chart 28").Height = 198
ActiveSheet.Shapes("Chart 28").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(7).Left = 261.36
ppt_sld.Shapes(7).Top = 264.24
''slide 4
wb1.Sheets("Sheet2").Select
Set ppt_sld = ppt_1.Slides(4)
ActiveSheet.ChartObjects("Chart 16").Activate
ActiveSheet.Shapes("Chart 16").Height = 198
ActiveSheet.Shapes("Chart 16").Width = 500.4
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 7.2
ppt_sld.Shapes(3).Top = 59.76
ActiveSheet.ChartObjects("Chart 18").Activate
ActiveSheet.Shapes("Chart 18").Height = 198
ActiveSheet.Shapes("Chart 18").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 516.24
ppt_sld.Shapes(4).Top = 59.76
ActiveSheet.ChartObjects("Chart 17").Activate
ActiveSheet.Shapes("Chart 17").Height = 198
ActiveSheet.Shapes("Chart 17").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(5).Left = 516.24
ppt_sld.Shapes(5).Top = 264.24
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveSheet.Shapes("Chart 3").Height = 198
ActiveSheet.Shapes("Chart 3").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(6).Left = 7.2
ppt_sld.Shapes(6).Top = 264.24
ActiveSheet.ChartObjects("Chart 4").Activate
ActiveSheet.Shapes("Chart 4").Height = 198
ActiveSheet.Shapes("Chart 4").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(7).Left = 261.36
ppt_sld.Shapes(7).Top = 264.24
'' slide 5
Set ppt_sld = ppt_1.Slides(5)
ActiveSheet.ChartObjects("Chart 19").Activate
ActiveSheet.Shapes("Chart 19").Height = 198
ActiveSheet.Shapes("Chart 19").Width = 500.4
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 7.2
ppt_sld.Shapes(3).Top = 59.76
ActiveSheet.ChartObjects("Chart 21").Activate
ActiveSheet.Shapes("Chart 21").Height = 198
ActiveSheet.Shapes("Chart 21").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 516.24
ppt_sld.Shapes(4).Top = 59.76
ActiveSheet.ChartObjects("Chart 20").Activate
ActiveSheet.Shapes("Chart 20").Height = 198
ActiveSheet.Shapes("Chart 20").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(5).Left = 516.24
ppt_sld.Shapes(5).Top = 264.24
ActiveSheet.ChartObjects("Chart 24").Activate
ActiveSheet.Shapes("Chart 24").Height = 198
ActiveSheet.Shapes("Chart 24").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(6).Left = 7.2
ppt_sld.Shapes(6).Top = 264.24
ActiveSheet.ChartObjects("Chart 25").Activate
ActiveSheet.Shapes("Chart 25").Height = 198
ActiveSheet.Shapes("Chart 25").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(7).Left = 261.36
ppt_sld.Shapes(7).Top = 264.24
''slide 6
wb1.Sheets("Sheet3").Select
Set ppt_sld = ppt_1.Slides(6)
ActiveSheet.ChartObjects("Chart 4").Activate
ActiveSheet.Shapes("Chart 4").Height = 198
ActiveSheet.Shapes("Chart 4").Width = 500.4
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 7.2
ppt_sld.Shapes(3).Top = 59.76
ActiveSheet.ChartObjects("Chart 6").Activate
ActiveSheet.Shapes("Chart 6").Height = 198
ActiveSheet.Shapes("Chart 6").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 516.24
ppt_sld.Shapes(4).Top = 59.76
ActiveSheet.ChartObjects("Chart 5").Activate
ActiveSheet.Shapes("Chart 5").Height = 198
ActiveSheet.Shapes("Chart 5").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(5).Left = 516.24
ppt_sld.Shapes(5).Top = 264.24
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").Height = 198
ActiveSheet.Shapes("Chart 1").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(6).Left = 7.2
ppt_sld.Shapes(6).Top = 264.24
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveSheet.Shapes("Chart 2").Height = 198
ActiveSheet.Shapes("Chart 2").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(7).Left = 261.36
ppt_sld.Shapes(7).Top = 264.24
''slide 7
Set ppt_sld = ppt_1.Slides(7)
ActiveSheet.ChartObjects("Chart 7").Activate
ActiveSheet.Shapes("Chart 7").Height = 198
ActiveSheet.Shapes("Chart 7").Width = 500.4
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 7.2
ppt_sld.Shapes(3).Top = 59.76
ActiveSheet.ChartObjects("Chart 9").Activate
ActiveSheet.Shapes("Chart 9").Height = 198
ActiveSheet.Shapes("Chart 9").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 516.24
ppt_sld.Shapes(4).Top = 59.76
ActiveSheet.ChartObjects("Chart 8").Activate
ActiveSheet.Shapes("Chart 8").Height = 198
ActiveSheet.Shapes("Chart 8").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(5).Left = 516.24
ppt_sld.Shapes(5).Top = 264.24
ActiveSheet.ChartObjects("Chart 12").Activate
ActiveSheet.Shapes("Chart 12").Height = 198
ActiveSheet.Shapes("Chart 12").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(6).Left = 7.2
ppt_sld.Shapes(6).Top = 264.24
ActiveSheet.ChartObjects("Chart 13").Activate
ActiveSheet.Shapes("Chart 13").Height = 198
ActiveSheet.Shapes("Chart 13").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(7).Left = 261.36
ppt_sld.Shapes(7).Top = 264.24
''slide 8
wb1.Sheets("Sheet4").Select
Set ppt_sld = ppt_1.Slides(8)
ActiveSheet.ChartObjects("Chart 4").Activate
ActiveSheet.Shapes("Chart 4").Height = 198
ActiveSheet.Shapes("Chart 4").Width = 500.4
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 7.2
ppt_sld.Shapes(3).Top = 59.76
ActiveSheet.ChartObjects("Chart 6").Activate
ActiveSheet.Shapes("Chart 6").Height = 198
ActiveSheet.Shapes("Chart 6").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 516.24
ppt_sld.Shapes(4).Top = 59.76
ActiveSheet.ChartObjects("Chart 5").Activate
ActiveSheet.Shapes("Chart 5").Height = 198
ActiveSheet.Shapes("Chart 5").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(5).Left = 516.24
ppt_sld.Shapes(5).Top = 264.24
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").Height = 198
ActiveSheet.Shapes("Chart 1").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(6).Left = 7.2
ppt_sld.Shapes(6).Top = 264.24
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveSheet.Shapes("Chart 2").Height = 198
ActiveSheet.Shapes("Chart 2").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(7).Left = 261.36
ppt_sld.Shapes(7).Top = 264.24
''slide 9
Set ppt_sld = ppt_1.Slides(9)
ActiveSheet.ChartObjects("Chart 7").Activate
ActiveSheet.Shapes("Chart 7").Height = 198
ActiveSheet.Shapes("Chart 7").Width = 500.4
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 7.2
ppt_sld.Shapes(3).Top = 59.76
ActiveSheet.ChartObjects("Chart 9").Activate
ActiveSheet.Shapes("Chart 9").Height = 198
ActiveSheet.Shapes("Chart 9").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 516.24
ppt_sld.Shapes(4).Top = 59.76
ActiveSheet.ChartObjects("Chart 8").Activate
ActiveSheet.Shapes("Chart 8").Height = 198
ActiveSheet.Shapes("Chart 8").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(5).Left = 516.24
ppt_sld.Shapes(5).Top = 264.24
ActiveSheet.ChartObjects("Chart 12").Activate
ActiveSheet.Shapes("Chart 12").Height = 198
ActiveSheet.Shapes("Chart 12").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(6).Left = 7.2
ppt_sld.Shapes(6).Top = 264.24
ActiveSheet.ChartObjects("Chart 13").Activate
ActiveSheet.Shapes("Chart 13").Height = 198
ActiveSheet.Shapes("Chart 13").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(7).Left = 261.36
ppt_sld.Shapes(7).Top = 264.24
''slide 10
wb1.Sheets("Sheet5").Select
Set ppt_sld = ppt_1.Slides(10)
ActiveSheet.ChartObjects("Chart 4").Activate
ActiveSheet.Shapes("Chart 4").Height = 198
ActiveSheet.Shapes("Chart 4").Width = 500.4
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 7.2
ppt_sld.Shapes(3).Top = 59.76
ActiveSheet.ChartObjects("Chart 6").Activate
ActiveSheet.Shapes("Chart 6").Height = 198
ActiveSheet.Shapes("Chart 6").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 516.24
ppt_sld.Shapes(4).Top = 59.76
ActiveSheet.ChartObjects("Chart 5").Activate
ActiveSheet.Shapes("Chart 5").Height = 198
ActiveSheet.Shapes("Chart 5").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(5).Left = 516.24
ppt_sld.Shapes(5).Top = 264.24
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").Height = 198
ActiveSheet.Shapes("Chart 1").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(6).Left = 7.2
ppt_sld.Shapes(6).Top = 264.246
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveSheet.Shapes("Chart 2").Height = 198
ActiveSheet.Shapes("Chart 2").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(7).Left = 261.36
ppt_sld.Shapes(7).Top = 264.24
''slide 11
Set ppt_sld = ppt_1.Slides(11)
ActiveSheet.ChartObjects("Chart 7").Activate
ActiveSheet.Shapes("Chart 7").Height = 198
ActiveSheet.Shapes("Chart 7").Width = 500.4
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 7.2
ppt_sld.Shapes(3).Top = 59.76
ActiveSheet.ChartObjects("Chart 9").Activate
ActiveSheet.Shapes("Chart 9").Height = 198
ActiveSheet.Shapes("Chart 9").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 516.24
ppt_sld.Shapes(4).Top = 59.76
ActiveSheet.ChartObjects("Chart 8").Activate
ActiveSheet.Shapes("Chart 8").Height = 198
ActiveSheet.Shapes("Chart 8").Width = 198
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(5).Left = 516.24
ppt_sld.Shapes(5).Top = 264.24
ActiveSheet.ChartObjects("Chart 12").Activate
ActiveSheet.Shapes("Chart 12").Height = 198
ActiveSheet.Shapes("Chart 12").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(6).Left = 7.2
ppt_sld.Shapes(6).Top = 264.24
ActiveSheet.ChartObjects("Chart 13").Activate
ActiveSheet.Shapes("Chart 13").Height = 198
ActiveSheet.Shapes("Chart 13").Width = 247
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(7).Left = 261.36
ppt_sld.Shapes(7).Top = 264.24
''credilt line charts
''slide 13
wb1.Sheets("Sheet1").Select
Set ppt_sld = ppt_1.Slides(13)
ActiveSheet.ChartObjects("Chart 21").Activate
ActiveSheet.Shapes("Chart 21").Height = 199.44
ActiveSheet.Shapes("Chart 21").Width = 653.76
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 33.12
ppt_sld.Shapes(3).Top = 59.04
ActiveSheet.ChartObjects("Chart 29").Activate
ActiveSheet.Shapes("Chart 29").Height = 199.44
ActiveSheet.Shapes("Chart 29").Width = 653.76
ActiveChart.ChartTitle.Text = "Credit Limit / Company - High Value"
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 33.12
ppt_sld.Shapes(4).Top = 263.52
''slide 14
wb1.Sheets("Sheet2").Select
Set ppt_sld = ppt_1.Slides(14)
ActiveSheet.ChartObjects("Chart 22").Activate
ActiveSheet.Shapes("Chart 22").Height = 199.44
ActiveSheet.Shapes("Chart 22").Width = 653.76
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 33.12
ppt_sld.Shapes(3).Top = 59.04
ActiveSheet.ChartObjects("Chart 23").Activate
ActiveSheet.Shapes("Chart 23").Height = 199.44
ActiveSheet.Shapes("Chart 23").Width = 653.76
ActiveChart.ChartTitle.Text = "Credit Limit / Company - High Value"
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 33.12
ppt_sld.Shapes(4).Top = 263.52
''slide 15
wb1.Sheets("Sheet3").Select
Set ppt_sld = ppt_1.Slides(15)
ActiveSheet.ChartObjects("Chart 10").Activate
ActiveSheet.Shapes("Chart 10").Height = 199.44
ActiveSheet.Shapes("Chart 10").Width = 653.76
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 33.12
ppt_sld.Shapes(3).Top = 59.04
ActiveSheet.ChartObjects("Chart 11").Activate
ActiveSheet.Shapes("Chart 11").Height = 199.44
ActiveSheet.Shapes("Chart 11").Width = 653.76
ActiveChart.ChartTitle.Text = "Credit Limit / Company - High Value"
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 33.12
ppt_sld.Shapes(4).Top = 263.52
''slide 16
wb1.Sheets("Sheet4").Select
Set ppt_sld = ppt_1.Slides(16)
ActiveSheet.ChartObjects("Chart 10").Activate
ActiveSheet.Shapes("Chart 10").Height = 199.44
ActiveSheet.Shapes("Chart 10").Width = 653.76
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 33.12
ppt_sld.Shapes(3).Top = 59.04
ActiveSheet.ChartObjects("Chart 11").Activate
ActiveSheet.Shapes("Chart 11").Height = 199.44
ActiveSheet.Shapes("Chart 11").Width = 653.76
ActiveChart.ChartTitle.Text = "Credit Limit / Company - High Value"
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 33.12
ppt_sld.Shapes(4).Top = 263.52
''slide 17
wb1.Sheets("Sheet5").Select
Set ppt_sld = ppt_1.Slides(17)
ActiveSheet.ChartObjects("Chart 10").Activate
ActiveSheet.Shapes("Chart 10").Height = 199.44
ActiveSheet.Shapes("Chart 10").Width = 653.76
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(3).Left = 33.12
ppt_sld.Shapes(3).Top = 59.04
ActiveSheet.ChartObjects("Chart 11").Activate
ActiveSheet.Shapes("Chart 11").Height = 199.44
ActiveSheet.Shapes("Chart 11").Width = 653.76
ActiveChart.ChartTitle.Text = "Credit Limit / Company - High Value"
ActiveChart.ChartArea.Copy
ppt_sld.Select
ppt_sld.Shapes.PasteSpecial ppPastePNG
ppt_sld.Shapes(4).Left = 33.12
ppt_sld.Shapes(4).Top = 263.52
''22 23 usb
'' 10 11 other
ppt_path = ThisWorkbook.Path & "\Presentation\Acquisition_Summary_" & month_name & "_" & year_num
If Len(Dir(ppt_path)) > 0 Then
SetAttr ppt_path, vbNormal
Kill ppt_path
End If
ppt_1.SaveAs ppt_path, 24 ''24 for .pptx format
ppt_1.Close
wb1.Close SaveChanges:=False
ppt_app_1.Quit
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Macro successfully executed"
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.