私のコードは、画像、範囲、およびテキスト ボックスを Excel から PowerPoint にエクスポートすることになっています。範囲をビットマップとして貼り付けるはずの場所でエラーが発生します。エラーは、変数が見つからないことを示しています。私は VBA を初めて使用するので、可能であればサポートが必要です。
私が使用しているコードは次のとおりです。
Option Explicit
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Sub copy_to_ppt()
Dim wsname As String
Dim Shapes As Shape
Dim Range As Range
Dim a, b As Integer
Set PPApp = New PowerPoint.Application
PPApp.Visible = True
Set PPPres = PPApp.Presentations.Open("C:\Users\gdjwherr\Desktop\Brazil Reports\TRP File\TRP Test Template.pptx")
Sheets("Sheet1").Select
'-----------------------------
ActiveSheet.Shapes("Picture 1").Select
Selection.Copy
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
PPApp.ActiveWindow.ViewType = ppViewSlide
PPSlide.Shapes.PasteSpecial(ppPasteJPG).Select
PPApp.ActiveWindow.Selection.ShapeRange(1).Top = PPApp.ActiveWindow.Selection.ShapeRange(1).Top + 60
PPApp.ActiveWindow.Selection.ShapeRange(1).Left = PPApp.ActiveWindow.Selection.ShapeRange(1).Left + 20
ActiveSheet.Range("D3:E8").Select
Selection.Copy
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
PPApp.ActiveWindow.ViewType = ppViewSlide
Selection.PasteSpecial DataType:=wdPasteBitmap ```This is where the error occurs stating variable not defined and highlights wdPasteBitmap
PPApp.ActiveWindow.Selection.ShapeRange(1).Top = PPApp.ActiveWindow.Selection.ShapeRange(1).Top + 60
PPApp.ActiveWindow.Selection.ShapeRange(1).Left = PPApp.ActiveWindow.Selection.ShapeRange(1).Left + 0
ActiveSheet.Range("G3:H8").Select
Selection.Copy
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
PPApp.ActiveWindow.ViewType = ppViewSlide
Selection.PasteSpecial DataType:=wdPasteBitmap
PPApp.ActiveWindow.Selection.ShapeRange(1).Top = PPApp.ActiveWindow.Selection.ShapeRange(1).Top + 60
PPApp.ActiveWindow.Selection.ShapeRange(1).Left = PPApp.ActiveWindow.Selection.ShapeRange(1).Left - 20
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub