Question

我需要将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：无效的请求。要选择形状，其视图必须处于活动状态。

你能帮我吗？

Answer 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

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

1 个答案: