简体   繁体   English

Excel vba将幻灯片复制到现有的PowerPoint演示文稿

[英]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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM