0

私のコードは、画像、範囲、およびテキスト ボックスを 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
4

1 に答える 1

0

少しリファクタリング...

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-25T18:34:09.467 に答える