使用CommandBars.ExecuteMso问题
浆果是从另一个excel文件的多个单元格的范围，瓜是幻灯片幻灯片中的表格。 我试图将Berry粘贴到ppt表中，首先在ppt表中select单元格（3,2）。 这样做后，我想取消任何select。 并select单元格（3.7）。
下面的代码成功地将范围粘贴到表格左上angular的Cell（3,2）中。
Berry.Copy Melon.Table.Cell(3, 2).Shape.Select Lemon.CommandBars.ExecuteMso ("PasteExcelTableDestinationTableStyle") 但是，当我尝试下面的代码，范围被粘贴到表格与左上angular的单元格（3,7）。 我会认为这个范围会按照前面的方法粘贴，然后只是select了Cell（3,7），而没有任何粘贴。
Berry.Copy Melon.Table.Cell(3, 2).Shape.Select Lemon.CommandBars.ExecuteMso ("PasteExcelTableDestinationTableStyle") Melon.Table.Cell(3, 7).Shape.Select
看起来ExecuteMso代码总是作为代码的最后一行被执行。 请原谅我的英语，我感谢你的时间和帮助。
以下是完整的代码：
Sub Auto() Application.CutCopyMode = False Dim apple As Workbook Dim grape As Workbook Dim orange As Range Dim Kiwi As Shape 'Shape Dim Peach As Object Dim Berry As Range Dim pear As Range Dim Lemon As PowerPoint.Application 'PPApp Dim LemonJuice As PowerPoint.Presentation 'PPpres Dim Melon As PowerPoint.Shape Dim LCounter As Integer Set grape = Workbooks.Open(Filename:="C:\Users\206521654\Documents\Automate vba\try.xlsx") Set apple = Workbooks.Open(Filename:="C:\Users\206521654\Documents\Automate vba\Monthly Report\Msia\Weekly Channel Ranking Broken Out.xlsx") Set orange = apple.Sheets("Periods").Range("A5:C25") orange.Copy grape.Sheets("Sheet1").Range("B3:D23").PasteSpecial xlPasteValues grape.Sheets("Sheet1").Range("E3").Formula = "=D3/C3-1" Set SourceRange = grape.Sheets("Sheet1").Range("E3") Set fillRange = grape.Sheets("Sheet1").Range("E3:E23") SourceRange.AutoFill Destination:=fillRange grape.Sheets("Sheet1").Range("E3:E23").NumberFormat = "0%" grape.Sheets("Sheet1").Range("B3:E23").Font.Name = "Calibri" grape.Sheets("Sheet1").Range("B3:E23").Font.Size = "11" grape.Sheets("Sheet1").Range("C3:D23").NumberFormat = "0.000" For Each Cell In grape.Sheets("Sheet1").Range("E3:E23") If Cell.Value < 0 Then Cell.Font.Color = vbRed Else: Cell.Font.Color = vbBlue End If Next Set Berry = grape.Sheets("Sheet1").Range("B3:E23") Berry.Copy Set Lemon = New PowerPoint.Application Set LemonJuice = Lemon.Presentations.Open("C:\Users\206521654\Documents\Automate vba\Automate test.pptx") Set Melon = LemonJuice.Slides(1).Shapes(8) Melon.Table.Cell(3, 2).Shape.Select Lemon.CommandBars.ExecuteMso "PasteExcelTableDestinationTableStyle" Melon.Table.Cell(7, 2).Shape.Select End Sub
所以这里是一些示例代码，它需要一个打开的Excel文档和打开的PowerPoint，并复制Excel表中的数据从PowerPoint中复制到一个新的表格。
您必须添加对您的Excel VBA的Powerpoint参考。
把excel中的单元格2,2和2,3放在一个新的表格中。
注意：由于我只是将文档中的一堆代码拼凑在一起，所以会得到一些不必要的function，例如每次创build一个新表并修改所有表，但是我希望这些代码可以作为向您展示如何工作的必要基础避免使用msoExecute。
Option Explicit Sub TestCopyData() Dim sSht As Worksheet Set sSht = ActiveWorkbook.Sheets("Sheet1") Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide 'Open PPT if not running, otherwise select active instance On Error Resume Next Set PPApp = GetObject(, "PowerPoint.Application") On Error GoTo 0 If PPApp Is Nothing Then 'Open PowerPoint Set PPApp = CreateObject("PowerPoint.Application") PPApp.Visible = True End If PPApp.ActivePresentation.Slides(1).Shapes _ .AddTable NumRows:=3, NumColumns:=4, Left:=10, _ Top:=10, Width:=288, Height:=288 Dim sh As Integer Dim col As PowerPoint.Column With PPApp.ActivePresentation.Slides(1) For sh = 1 To .Shapes.Count If .Shapes(sh).HasTable Then For Each col In .Shapes(sh).Table.Columns Dim cl As PowerPoint.Cell For Each cl In .Shapes(sh).Table.Rows(2).Cells cl.Shape.Fill.ForeColor.RGB = RGB(50, 125, 0) Next cl .Shapes(sh).Table.Columns(1).Width = 110 .Shapes(sh).Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = sSht.Cells(2, 2) .Shapes(sh).Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = sSht.Cells(2, 3) Next col End If Next End With End Sub