想要powerpoint中的VBA代码将excel中的所有图表显示在ppt中的不同幻灯片上吗

我在excel中开发了vba代码，将excel中的所有图表显示在ppt中的不同幻灯片上。但我希望vba代码在powerpoint中实现，而不是在excel中实现，这样我就可以使用该宏在powerpoint中创建加载项。我曾尝试在powerpoint中实现excel vba代码，但在ppt中不起作用。问题是它正在将图表从excel复制到ppt幻灯片

Sub Button1()

    Set pptApp = New PowerPoint.Application
    Set pptPres = pptApp.ActivePresentation

    Dim xlApp As Object
    Dim xlWorkBook As Object
    Dim wb As Workbook

    Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = True
    Set wb = xlApp.Workbooks.Open("C:\Users\tonmoy.roy\Desktop\Meeting Files\Monthly Review July 10.xls", True, False)

    Dim WAIT As Double

    WAIT = Timer
    While Timer < WAIT + 10
        DoEvents  'do nothing
    Wend

    wb.Activate

    Dim ws As Worksheet
    Dim intChNum As Integer
    Dim objCh As Object

    'Count the embedded charts.
    For Each ws In wb.Worksheets
        intChNum = intChNum + ws.ChartObjects.Count
    Next ws

    'Check if there are chart (embedded or not) in the active workbook.
    If intChNum + ActiveWorkbook.Charts.Count < 1 Then
        MsgBox "Sorry, there are no charts to export!", vbCritical, "Ops"
        Exit Sub
    End If


    'Loop through all the embedded charts in all worksheets.
    For Each ws In wb.Worksheets
        For Each objCh In ws.ChartObjects
            Call pptFormat(objCh.Chart)
        Next objCh
    Next ws

    'Loop through all the chart sheets.
    For Each objCh In wb.Charts
        Call pptFormat(objCh)
    Next objCh

    'Show the power point.
    pptApp.Visible = True

    'Cleanup the objects.
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing

    'Infrom the user that the macro finished.
    MsgBox "The charts were copied successfully to the new presentation!", vbInformation, "Done"

End Sub

Private Sub pptFormat(xlCh As Chart)
    'Formats the charts/pictures and the chart titles/textboxes.

    Dim chTitle As String
    Dim j As Integer

    On Error Resume Next
    'Get the chart title and copy the chart area.
    chTitle = xlCh.ChartTitle.Text
    xlCh.ChartArea.Copy

    'Count the slides and add a new one after the last slide.
    pptSlideCount = pptPres.Slides.Count
    Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)

    'Paste the chart and create a new textbox.
    pptSlide.Shapes.PasteSpecial ppPasteJPG
    If chTitle <> "" Then
        pptSlide.Shapes.AddTextbox msoTextOrientationHorizontal, 12.5, 20, 694.75, 55.25
    End If

    'Format the picture and the textbox.
    For j = 0 To pptSlide.Shapes.Count
        With pptSlide.Shapes(j)
            'Picture position.
            If .Type = msoPicture Then
                .Top = 87.84976
                .Left = 33.98417
                .Height = 422.7964
                .Width = 646.5262
            End If
            'Text box position and formamt.
            If .Type = msoTextBox Then
                With .TextFrame.TextRange
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = chTitle
                    .Font.Name = "Tahoma (Headings)"
                    .Font.Size = 28
                    .Font.Bold = msoTrue
                End With
            End If
        End With
    Next j
End Sub

子按钮1（）
设置pptApp=新建PowerPoint.Application
设置pptPres=pptApp.ActivePresentation
将xlApp作为对象
将工作簿设置为对象
将wb设置为工作簿
设置xlApp=CreateObject（“Excel.Application”）
xlApp.Visible=True
设置wb=xlApp.Workbooks.Open（“C:\Users\tonmoy.roy\Desktop\Meeting Files\Monthly Review July 10.xls”，对，错）
暗淡的等待
等待=计时器
当定时器<等待+10时
你什么都不做吗
温德
wb.激活
将ws设置为工作表
作为整数的Dim intChNum
作为对象的Dim objCh
'计算嵌入的图表。
对于wb.工作表中的每个ws
intChNum=intChNum+ws.ChartObjects.Count
下一个ws
'检查活动工作簿中是否有图表（嵌入或未嵌入）。
如果intChNum+ActiveWorkbook.Charts.Count小于1，则
MsgBox“对不起，没有要导出的图表！”，vbCritical，“Ops”
出口接头
如果结束
'循环浏览所有工作表中的所有嵌入图表。
对于wb.工作表中的每个ws
对于ws.ChartObjects中的每个对象
调用pptFormat（objCh.Chart）
下一个objCh
下一个ws
'循环浏览所有图表表。
对于wb.图表中的每个objCh
调用pptFormat（objCh）
下一个objCh
'显示电源点。
pptApp.Visible=True
'清理对象。
设置pptSlide=Nothing
设置pptPres=Nothing
设置pptApp=无
'通知用户宏已完成。
MsgBox“图表已成功复制到新演示文稿！”，vbInformation，“完成”
端接头
私有子PPT格式（xlCh As图表）
'格式化图表/图片和图表标题/文本框。
将标题设置为字符串
作为整数的Dim j
出错时继续下一步
'获取图表标题并复制图表区域。
chTitle=xlCh.ChartTitle.Text
xlCh.ChartArea.Copy
'对幻灯片进行计数，并在最后一张幻灯片之后添加一张新幻灯片。
pptSlideCount=pptPres.Slides.Count
设置pptSlide=pptPres.Slides.Add（pptSlideCount+1，ppLayoutBlank）
'粘贴图表并创建新的文本框。
pptSlide.Shapes.paste特殊ppPasteJPG
如果标题为“”，则
pptSlide.Shapes.AddTextbox msoTextOrientationHorizontal，12.5,20694.75,55.25
如果结束
'格式化图片和文本框。
对于j=0到pptSlide.Shapes.Count
具有PPT滑动形状（j）
“图片位置。
如果.Type=msoPicture，则
.Top=87.84976
.左=33.98417
.高度=422.7964
.宽度=646.5262
如果结束
'文本框位置和格式。
如果.Type=msoTextBox，则
使用.TextFrame.TextRange
.ParagraphFormat.Alignment=ppAlignCenter
.Text=chTitle
.Font.Name=“Tahoma（标题）”
.Font.Size=28
.Font.Bold=msoTrue
以
如果结束
以
下一个j
端接头

私有子PPT格式（xlCh作为图表）

应为：

---

私有子PPT格式（xlCh作为Excel.Chart）

PowerPoint的对象模型中有一个图表，因此您需要将其更改为显式的Excel.Chart

我想你已经有了推荐人了

如果intChNum+ActiveWorkbook.Charts.Count<1，则

应为：

如果intChNum+wb.Charts.Count<1，则

此外，正如我在pptFormat函数中看到的那样，您的变量没有正确声明。调暗它们并在编码中使用Option Explicit

从长远来看，选项显式比必须键入DEC的任何不便都更有帮助。

Tonmoy Roy， 你应该用另一个帖子问你的第二个问题。但是这里有一些代码让您选择一个文件并获取它的名称、路径或整个名称/路径

Set XLapp = New Excel.Application
'choose the data file
     With Application.FileDialog(msoFileDialogFilePicker)
       .AllowMultiSelect = False
               ' Set the title of the dialog box.
      .Title = "Select the Data File (Data File.xlsx)."
        'clear filters so all file are shown
      .Filters.Clear
             ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
      If .Show = True Then
        FullName = .SelectedItems(1) 'name and path 
      End If
   End With
   fname = Dir(FullName) ' gets just the file name and not the path
   XLapp.Visible = True
Set xlWorkBook = XLapp.Workbooks.Open(FullName, False, True)  'Opens the data xlsx file

---

当代码超过几行时，通过描述代码不起作用的原因来帮助我们总是明智的。否则我们必须彻底检查整个代码…我很抱歉。我需要更具体一些。你是对的。下次我一定会记住的。太好了。你是个天才兄弟！！Excel.chart成功了。谢谢你的帮助。你能用同样的代码帮我做一件事吗。如何浏览计算机路径并选择所需的excel文件，而不是像我那样直接给出路径和文件名（C:\Users\tonmoy.roy\Desktop\Meeting Files\Monthly Review July 10.xls）。我知道在excel vba中执行此操作的代码，但我是powerpoint vba的新手。如果你帮我做最后一件事，我将非常感激。提前谢谢。嗨，Tonmoy，很高兴能为您提供帮助！最后一件事，如果你对答案感到满意，你能检查一下答案是否被接受，我们都能在这个平台上获得分数……这个选项在哪里？我找不到。对不起。我是这个平台的新手。但我会记住的。我会用不同的思路问不同的问题。你的代码对我有用。谢谢