在PowerPoint中需要一个VBA代码来显示Excel中的所有图表到不同的幻灯片

我在Excel中开发了vba代码,以便在excel中将所有图表显示在ppt中的不同幻灯片中。 但是我希望vba代码能够在powerpoint中实现,而不是在excel中实现,这样我就可以用这个macros在powerpoint中创build一个插件。 我试图在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 

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

另外你的variables没有被正确的声明,就像我在pptFormat函数中看到的那样。 将它们变暗并在编码中使用Option Explicit。

Option Explicit有助于长期运行,而不必input十进制数字。

Tonmoy Roy,你应该在另一个线程中问你的第二个问题。 但是这里有一些代码让你select一个文件,并得到它的名字,path或只是整个名称/path

 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