想要Powerpoint中的VBA代码以将excel中的所有图表显示为ppt中的不同幻灯片

Question

我已经在excel中开发了vba代码，以将excel中的所有图表显示到ppt中的不同幻灯片上。 但是我希望在Powerpoint中实现VBA代码而不是在Excel中实现，以便我可以在Powerpoint中使用该宏创建一个插件。 我试图在PowerPoint中实现excel vba代码，但是在ppt中不起作用。 问题是它正在将图表从excel复制到ppt幻灯片。我在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

Answer 1

Private Sub pptFormat(xlCh As Chart)应该是：

Private Sub pptFormat(xlCh As Excel.Chart) 。

PowerPoint在其对象模型中有一个图表，因此您需要对其进行更改以明确表示Excel.Chart

我假设您已经有了参考

If intChNum + ActiveWorkbook.Charts.Count < 1 Then应该是：

If intChNum + wb.Charts.Count < 1 Then

另外，据我在pptFormat函数中看到的那样，您的变量未正确声明。 将它们变暗并在编码中使用Option Explicit。

Option Explicit对长期运行的影响要大于必须输入decs带来的任何不便。

Answer 2

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