【问题标题】:Excel vba to copy slides to an existing powerpoint presentationExcel vba 将幻灯片复制到现有的 powerpoint 演示文稿
【发布时间】: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:无效请求。要选择一个形状,它的视图必须处于活动状态。

你能帮帮我吗?

【问题讨论】:

    标签: excel vba


    【解决方案1】:

    必须激活形状才能对其执行任何操作

    以下是我创建的用于从 Excel 复制图表并粘贴到现有 PPT 模板(图片格式)的代码

    您还可以使用 for 循环来遍历每张工作表中的图表。我不能这样做,因为每张表中的图表名称都不相同

    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
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2019-11-04
      • 2020-08-08
      • 1970-01-01
      • 1970-01-01
      • 2013-12-14
      • 1970-01-01
      • 2018-03-29
      • 2013-06-07
      相关资源
      最近更新 更多