Question

Sub Export_Allcahrts_ppt()

Dim mypowerpoint As PowerPoint.Application

Set mypowerpoint = New PowerPoint.Application

mypowerpoint.Visible = msoTrue

Dim mypowerpoint_pres  As PowerPoint.Presentation

Set mypowerpoint_pres = mypowerpoint.Presentations.Add

Dim myslide  As PowerPoint.Slide

Set myslide = mypowerpoint_pres.Slides.Add(1, ppLayoutBlank)

Dim mychart  As ChartObject

Dim j As Long
j = 0
For Each mychart In Sheet1.ChartObjects
j = j + 1
Next


For Each mychart In Sheet1.ChartObjects

mychart.Copy

myslide.Shapes.PasteSpecial ppPasteBitmap

myslide.Shapes(1).Top = 100

myslide.Shapes(1).Height = 200

myslide.Shapes(1).Left = 30

If mypowerpoint_pres.Slides.Count < j Then

Set myslide = mypowerpoint_pres.Slides.Add(mypowerpoint_pres.Slides.Count + 1, ppLayoutBlank)

Else

Exit Sub

End If

Next


End Sub

Answer 1

首先，你不需要循环来获得j;只需使用

j = Sheet1.ChartObjects.Count

但你也根本不需要j。如果幻灯片的数量还不等于到目前为止复制的图表数量，那么您的代码所做的就是为每个新图表插入一张新幻灯片。

所以试试这个稍微重新排列和简化的代码。我还没有测试过，但我认为我没有改变语法。

Sub Export_Allcahrts_ppt()
  Dim mypowerpoint As PowerPoint.Application
  Dim mypowerpoint_pres As PowerPoint.Presentation
  Dim myslide As PowerPoint.Slide
  Dim mychart As ChartObject
  Dim j As Long

  Set mypowerpoint = New PowerPoint.Application
  mypowerpoint.Visible = msoTrue

  Set mypowerpoint_pres = mypowerpoint.Presentations.Add

  Set myslide = mypowerpoint_pres.Slides.Add(1, ppLayoutBlank)

  j = Sheet1.ChartObjects.Count

  For Each mychart In Sheet1.ChartObjects
    mychart.Copy
    myslide.Shapes.PasteSpecial ppPasteBitmap

    With myslide.Shapes(myslide.Shapes.Count)
      .Top = 100
      .Height = 200
      .Left = 30
    End With
  Next

End Sub

VBA - 将excel图表导出到同一幻灯片上的电源点

1 个答案: