我正在研究一個 VBA 腳本，它將一些范圍從 Excel 復制到 PowerPoint。我能夠成功地做到這一點而沒有任何錯誤。但是，在復制范圍后，當我重新調整形狀大小并重新對齊形狀時，我無法這樣做。你能幫我知道我可能會錯過什么嗎？
我在一個單獨的檔案中定義了 Excel、幻燈片編號和主 Excel 作業表的范圍。所以到目前為止，我正在從那個單獨的檔案中獲取所有值。
Option Explicit
Sub ExportToPPT()
Dim ppt_app As New PowerPoint.Application
Dim pre As PowerPoint.Presentation
Dim slide As PowerPoint.slide
Dim shp As PowerPoint.Shape
Dim wb As Workbook
Dim rng As Range
Dim vSheet$
Dim vRange$
Dim vWidth As Double
Dim vHeight As Double
Dim vTop As Double
Dim vLeft As Double
Dim expRng As Range
Dim vslidenum As Long
Dim Adminsh As Worksheet
Dim configRng As Range
Dim xlfile$
Dim pptfile$
Application.DisplayAlerts = False
Set Adminsh = ThisWorkbook.Sheets("Admin")
'Range Loop is the loop ramge where we are defining the sheets
Set configRng = Adminsh.Range("RangeLoop")
xlfile = Adminsh.[ExcelPath]
pptfile = Adminsh.[PPTPath]
Set wb = Workbooks.Open(xlfile)
Set pre = ppt_app.Presentations.Open(pptfile)
wb.Activate
For Each rng In configRng
'Pick Values from Excel Sheet --------------------------------
With Adminsh
vSheet$ = .Cells(rng.Row, 2).Value
vRange$ = .Cells(rng.Row, 3).Value
vWidth = .Cells(rng.Row, 4).Value
vHeight = .Cells(rng.Row, 5).Value
vTop = .Cells(rng.Row, 6).Value
vLeft = .Cells(rng.Row, 7).Value
vslidenum = .Cells(rng.Row, 8).Value
End With
wb.Activate
Sheets(vSheet$).Activate
Set expRng = Sheets(vSheet$).Range(vRange$)
expRng.Copy
'Paste Values in Power Point-----------------------------------------------
Set slide = pre.Slides(vslidenum)
'ppt_app.Activate
slide.Shapes.PasteSpecial ppPasteBitmap
'ppt_app.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse
'slide.Shapes.PasteSpecial DataType:=ppPasteBitmap, Link:=msoFalse
Set shp = slide.Shapes(1)
With shp
.Top = vTop
.Left = vLeft
.Width = vWidth
.Height = vHeight
End With
Application.CutCopyMode = False
Set shp = Nothing
Set slide = Nothing
'This line below is showing error(compile error)
'Application.CutCopyMode = False
'Application.CutCopyMode = False
'aPPLICATION.CU
Set expRng = Nothing
Next rng
pre.Save
'pre.Close
Set pre = Nothing
Set ppt_app = Nothing
Set expRng = Nothing
wb.Close False
Set wb = Nothing
Application.DisplayAlerts = True
End Sub
uj5u.com熱心網友回復：
認為您可能使用常量索引 1 參考了錯誤的形狀。
Set shp = slide.Shapes(1)
您插入的形狀可能位于串列的末尾。
嘗試這樣做：
Set shp = slide.Shapes(slide.Shapes.Count)
uj5u.com熱心網友回復：
您可以一次性完成，而不是粘貼然后分配形狀...
這是一個例子
Set shp = slide.Shapes.PasteSpecial(ppPasteBitmap)
With shp
'~~> Do what you want
End With
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/405373.html
標籤：