PowerPoint VBA 在 运行 期间无法识别 Excel table
PowerPoint VBA does not recognize Excel table during run
我有一段代码可以从我的 excel 文件中复制一个范围并将其粘贴到 PowerPoint 中的活动幻灯片上。经过数小时的尝试将 excel 的范围粘贴为 table(不是图像),我发现以下代码可以成功运行。注:myPP = powerpoint application.
myPP.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
myPP.CommandBars.ReleaseFocus
问题是当我执行宏时,table 被粘贴,但是 vba 不识别 table 除非代码被单步执行。我用下面的代码测试了这个。在执行过程中,代码会被完全跳过,但在单步执行过程中会触发。
For Each shp In activeSlide.Shapes
If shp.HasTable Then
MsgBox shp.Name
End If
Next
下面是完整代码。基本上,我只想将 excel 范围作为 table 粘贴到我的 powerpoint 中,然后扩展 table 以适合幻灯片。我对修改它的建议持开放态度。感谢您的帮助
Dim myPP as Object
Dim activeSlide as Object
Dim shp as Object
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range(Cells(1,1), Cells(4,7)).Copy
Worksheets("Sheet1").Activate
myPP.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
myPP.CommandBars.ReleaseFocus
Dim myTable As String
For Each shp In activeSlide.Shapes
If shp.HasTable Then
MsgBox shp.Name
myTable = shp.Name
End If
Next
With activeSlide.Shapes(myTable)
.Left = 23
.Top = 105
.Width = 650
.Height = 375
End With
灰
Dim myPP As Object 'Powerpoint.Application
Dim myPres As Object 'Powerpoint.Presentation
Dim activeSlide As Object 'Powerpoint.Slide
Set myPP = CreateObject("Powerpoint.Application")
myPP.Visible = True
Set myPres = myPP.Presentations.Add
myPP.ActiveWindow.ViewType = 1 'ppViewSlide
Set activeSlide = myPres.slides.Add(1, 12) 'ppLayoutBlank
问题在于我们无法预测粘贴操作将持续多长时间以及何时完成。我们需要等待它完成。
' first let us count the shapes in the slide
Dim shapeCount As Integer: shapeCount = activeSlide.Shapes.Count
myPP.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
Do '<~~ wait completion of paste operation
DoEvents
Loop Until activeSlide.Shapes.Count > shapeCount
' Now, our table is the last in the shapes collection.
With activeSlide.Shapes(activeSlide.Shapes.Count)
.Left = 23
.Top = 105
.Width = 650
.Height = 375
End With
我有一段代码可以从我的 excel 文件中复制一个范围并将其粘贴到 PowerPoint 中的活动幻灯片上。经过数小时的尝试将 excel 的范围粘贴为 table(不是图像),我发现以下代码可以成功运行。注:myPP = powerpoint application.
myPP.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
myPP.CommandBars.ReleaseFocus
问题是当我执行宏时,table 被粘贴,但是 vba 不识别 table 除非代码被单步执行。我用下面的代码测试了这个。在执行过程中,代码会被完全跳过,但在单步执行过程中会触发。
For Each shp In activeSlide.Shapes
If shp.HasTable Then
MsgBox shp.Name
End If
Next
下面是完整代码。基本上,我只想将 excel 范围作为 table 粘贴到我的 powerpoint 中,然后扩展 table 以适合幻灯片。我对修改它的建议持开放态度。感谢您的帮助
Dim myPP as Object
Dim activeSlide as Object
Dim shp as Object
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range(Cells(1,1), Cells(4,7)).Copy
Worksheets("Sheet1").Activate
myPP.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
myPP.CommandBars.ReleaseFocus
Dim myTable As String
For Each shp In activeSlide.Shapes
If shp.HasTable Then
MsgBox shp.Name
myTable = shp.Name
End If
Next
With activeSlide.Shapes(myTable)
.Left = 23
.Top = 105
.Width = 650
.Height = 375
End With
灰
Dim myPP As Object 'Powerpoint.Application
Dim myPres As Object 'Powerpoint.Presentation
Dim activeSlide As Object 'Powerpoint.Slide
Set myPP = CreateObject("Powerpoint.Application")
myPP.Visible = True
Set myPres = myPP.Presentations.Add
myPP.ActiveWindow.ViewType = 1 'ppViewSlide
Set activeSlide = myPres.slides.Add(1, 12) 'ppLayoutBlank
问题在于我们无法预测粘贴操作将持续多长时间以及何时完成。我们需要等待它完成。
' first let us count the shapes in the slide
Dim shapeCount As Integer: shapeCount = activeSlide.Shapes.Count
myPP.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
Do '<~~ wait completion of paste operation
DoEvents
Loop Until activeSlide.Shapes.Count > shapeCount
' Now, our table is the last in the shapes collection.
With activeSlide.Shapes(activeSlide.Shapes.Count)
.Left = 23
.Top = 105
.Width = 650
.Height = 375
End With