Question

我的代码应该将图片，范围和文本框从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

Answer 1

一点点重构......

Sub copy_to_ppt()

    Dim PPApp As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide
    Dim wsname As String
    'Dim Shapes  As Shape 'don't do this!
    'Dim Range As Range 'don't do this!
    Dim a, b As Integer
    Dim oLayout

    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")
    PPApp.ActiveWindow.ViewType = ppViewSlide
    Set ppSlide = PPPres.Slides _
        (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

    Sheets("Sheet1").Shapes("Picture 1").Copy
    PP_Paste ppSlide, ppPasteJPG, 100, 100

    Sheets("Sheet1").Range("D3:E8").Copy
    PP_Paste ppSlide, ppPasteBitmap, 100, 300

    Sheets("Sheet1").Range("G3:H8").Copy
    PP_Paste ppSlide, ppPasteBitmap, 100, 500

    Set ppSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing

End Sub

Sub PP_Paste(ppSlide As PowerPoint.Slide, fmt, posTop, posLeft)
    With ppSlide.Shapes.PasteSpecial(fmt)
        .Top = posTop
        .Left = posLeft
    End With
End Sub

粘贴时找不到变量

1 个答案: