粘貼時未找到變量

我的代碼應該將圖片，範圍和文本框從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

來源

2013-09-25 William

你能與任何堆棧跟蹤沿後確切的錯誤信息？ –

'wdPasteBitmap'看起來像一個Word VBA常量 - 這不會在Excel VBA中可用。您可能需要'ppPasteBitmap' –

@Tim Williams確定已更改爲'ppPasteBitmap'，現在出現運行時錯誤1004應用程序定義或對象定義的錯誤？ – William

重構的一點點...

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

來源

2013-09-25 18:34:09

工程非常好，只需添加一些東西在這裏和那裏得到的文本框以及...謝謝你 – William

我將如何添加文件，我需要excel打開，而不是一個新的演示文稿我想添加一個我已經？ – William

使用與原始問題中相同的代碼。我跑了一個新的演示文稿，因爲我測試的速度更快......查看我的編輯。 –

粘貼時未找到變量

回答

相關問題