使用CommandBars.ExecuteMso問題

Question

Berry是來自另一個Excel文件的多個單元格的範圍，Melon是幻燈片中的一個表格。我試圖將Berry粘貼到ppt表中，方法是首先在ppt表中選擇單元格（3,2）。這樣做後，我想取消選擇任何東西。並選擇單元格（3.7）。

以下代碼成功地將範圍粘貼到表格的左上角的單元格（3,2）中。

Berry.Copy 
Melon.Table.Cell(3, 2).Shape.Select 

Lemon.CommandBars.ExecuteMso ("PasteExcelTableDestinationTableStyle") 

但是，當我嘗試下面的代碼，範圍被粘貼到表格與左上角的單元格（3,7）。我認爲這個範圍會按照前面的方法粘貼，然後只是選擇沒有任何粘貼的單元格（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 

Answer 1

因此，這裏是一些示例代碼，接管從Excel表中數據的開放式Excel文檔，並打開PowerPoint，並拷貝到新表中的PowerPoint。

您必須將powerpoint引用添加到您的excel VBA中。

把東西放入Excel的單元格2,2和2,3中，它應該粘貼到一個新的表格中。

注：因爲我只是搗碎一堆​​從文檔代碼放在一起，你會得到一些不必要的功能，如創建新表每次和修改所有表，但我希望這個代碼作爲一個必要的基礎向您展示如何避免使用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