excel - CommandBars.ExecuteMso 的使用问题

Question

Berry 是来自另一个 excel 文件的多个单元格的范围，Melon 是 powerpoint 幻灯片中的表格。我试图通过首先选择 ppt 表上的单元格(3,2)将 Berry 粘贴到 ppt 表中。这样做之后，我想取消选择任何内容。并选择单元格(3.7)。

以下代码成功地将范围粘贴到左上角的 Cell(3,2) 表中。

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

Lemon.CommandBars.ExecuteMso ("PasteExcelTableDestinationTableStyle")

但是，当我尝试以下代码时，范围会粘贴到左上角的 Cell(3,7) 表格中。我认为该范围将按照之前的方式粘贴，然后仅选择 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

Answer 1

所以这里有一些示例代码，它获取一个打开的 excel 文档和打开的 powerpoint，并将表格数据从 excel 复制到 powerpoint 中的新表格中。

你 必须 将 powerpoint 引用添加到您的 excel VBA。

在 excel 中的单元格 2,2 和 2,3 中放置一些东西，它应该粘贴到 powerpoint 的新表格中。

注:由于我只是将文档中的一堆代码混合在一起，因此您会获得一些不必要的功能，例如每次都创建一个新表并修改所有表，但我希望这些代码可以作为向您展示如何避免使用的必要基础mso 执行。

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