使用CommandBars.ExecuteMso个问题

Question

Berry 是另一个 excel 文件中多个单元格的范围，而 Melon 是 powerpoint 幻灯片中的 table。我试图通过首先 selecting ppt table 上的单元格（3,2）将 Berry 粘贴到 ppt table 中。这样做之后，我想取消select 任何东西。和 select 单元格（3.7）。

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

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

Lemon.CommandBars.ExecuteMso ("PasteExcelTableDestinationTableStyle")

但是，当我尝试以下代码时，范围被粘贴到左上角带有 Cell(3,7) 的 table 中。我认为范围将按照之前的方式粘贴，然后仅将 Cell(3,7) selected 而不进行任何粘贴。

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:\Users6521654\Documents\Automate     vba\try.xlsx")
Set apple = Workbooks.Open(Filename:="C:\Users6521654\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:\Users6521654\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 并将 table 数据从 excel 复制到 powerpoint 中的新 table .

您必须将 powerpoint 参考添加到您的 excel VBA.

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

注意：因为我只是把文档中的一堆代码混在一起，你会得到一些不必要的功能，比如每次创建一个新的 table 并修改所有tables，但我希望这段代码可以作为向您展示如何避免使用 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

使用CommandBars.ExecuteMso个问题

Use of CommandBars.ExecuteMso problems

excel

powerpoint

vba