我在下面的代码中处理从Office 13中的Excel文件自动生成Powerpoint演示文稿.VBA代码在Excel中并使用PowerPoint对象库 .
该表正确地从Excel复制到PowerPoint,但是当尝试使用copyTable Sub设置表的位置时,PowerPoint不会移动它 .
在调试时,ShapeRange具有正确的位置,但这不会反映在PowerPoint窗口中 . 即使是奇怪的,它也会在左侧的幻灯片预览窗格中正确显示 . 有什么建议?
Sub buildPowerPoint()
'Declare initial variables
Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim oPPTSlide As PowerPoint.Slide
Dim strPresCurPath, strPresNewPath As String
Dim slideNum As Integer
Dim rng As Range
'Set old and new paths
strPresCurPath = ActiveWorkbook.Path & "\D0511AB UAT Status Base v3.pptx"
strPresNewPath = ActiveWorkbook.Path & "\D0511AB UAT Status " & Month(Date) & "_" & Day(Date) & "_" & Year(Date) & " 1200CT"
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set oPPTApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If oPPTApp Is Nothing Then Set oPPTApp = CreateObject(class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
oPPTApp.Visible = msoTrue
oPPTApp.Activate
Set oPPTFile = oPPTApp.Presentations.Open(strPresCurPath)
Sheets("Graphs").Select
slideNum = 2
Set oPPTSlide = oPPTFile.Slides(slideNum)
Set rng = ThisWorkbook.Worksheets("Graphs").Range("A141:D146")
DoEvents
rng.Copy
DoEvents
Call copyTable(42, 42, oPPTSlide)
Debug.Print ("Finished")
End Sub
copyTable Sub
Sub copyTable(leftPos As Integer, topPos As Integer, oPPTSlid As Slide)
Set myShapeRange = oPPTSlid.Shapes.PasteSpecial(DataType:=ppPasteDefault)
myShapeRange.left = leftPos
myShapeRange.top = topPos
Debug.Print (myShapeRange.top)
Debug.Print (myShapeRange.left)
End Sub