Question

我已经在excel中开发了vba代码，以便在ppt中将excel中的所有图表显示给不同的幻灯片。但我希望vba代码在powerpoint而不是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。

选项明确有助于长期运行，而不是必须输入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

想要在powerpoint中使用VBA代码，以便在ppt

2 个答案: