VBA错误438,使用Excel中的值进行PPT幻灯片移动

时间:2015-06-04 13:10:31

标签: excel vba excel-vba powerpoint powerpoint-vba

使用下面的代码,当我尝试将幻灯片移动到已创建的部分时,我收到438错误。最后4行代码。 很抱歉,如果此代码不清楚,但我是VBA新手。

Private Sub CopyandPastetoPPT(Counter As Integer)
Dim NextShape As Integer
Dim IssueName As String
Dim IssueDesc As String
Dim CfoNumber As String
Dim IndName As String
Dim Cat1 As Variant

    IssueName = Worksheets("Data_Sheet").Cells(Counter, 1)
    IssueDesc = Worksheets("Data_Sheet").Cells(Counter, 3)
    CfoNumber = Worksheets("Data_Sheet").Cells(Counter, 5)
    IndName = Worksheets("Data_Sheet").Cells(Counter, 7)
    Cat1 = Worksheets("Data_Sheet").Cells(Counter, 9)

    Set PP_Slide = PP_File.Slides(Counter + 1)

    PP_Slide.Shapes.AddShape Type:=msoShapeRectangle, _
         Left:=0, Top:=0, Width:=276, Height:=59

    NextShape = PP_Slide.Shapes.Count

    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Text = IssueName
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Size = 16
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Color = vbBlack
    PP_Slide.Shapes(NextShape).TextFrame.VerticalAnchor = msoAnchorMiddle

    PP_Slide.Shapes.AddShape Type:=msoShapeRectangle, _
         Left:=276, Top:=0, Width:=153, Height:=59

    NextShape = PP_Slide.Shapes.Count

    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Text = IssueDesc
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Size = 16
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Color = vbWhite
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.ParagraphFormat.SpaceBefore = 0
    PP_Slide.Shapes(NextShape).TextFrame.VerticalAnchor = msoAnchorMiddle
    PP_Slide.Shapes(NextShape).Fill.BackColor.RGB = RGB(0, 0, 0)

    PP_Slide.Shapes.AddShape Type:=msoShapeRectangle, _
        Left:=199, Top:=59, Width:=77, Height:=30

    NextShape = PP_Slide.Shapes.Count

    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Text = CfoNumber
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Size = 10
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Bold = False
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Color = vbBlack
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.ParagraphFormat.SpaceBefore = 0
    PP_Slide.Shapes(NextShape).TextFrame.VerticalAnchor = msoAnchorMiddle
    PP_Slide.Shapes(NextShape).Line.Visible = False

    PP_Slide.Shapes.AddShape Type:=msoShapeRectangle, _
        Left:=597, Top:=507, Width:=123, Height:=18

    NextShape = PP_Slide.Shapes.Count

    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Text = IndName
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Size = 10
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Italic = True
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Bold = False
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Color = vbBlack
    PP_Slide.Shapes(NextShape).TextFrame.TextRange.ParagraphFormat.SpaceBefore = 0
    PP_Slide.Shapes(NextShape).TextFrame.VerticalAnchor = msoAnchorMiddle
    PP_Slide.Shapes(NextShape).Line.Visible = False

    If Cat1 = "Center Consoles" Then

    PP_Slide.MoveToSection "Center Consoles"

    End If

End Sub

0 个答案:

没有答案