VBA Excel到PPT输出

Question

我想将一些代码从一个工作簿传输到另一个，我无法弄清楚为什么它不工作。我将这些工作表转移到新的工作簿中，并在代码中进行必要的更新以引用正确的工作表。工作簿之间的其他所有内容都是一致的，但我不断收到编译错误：用户定义的类型未定义。我试过调试，但我不确定它指向什么。提前致谢。

Sub CreatePP() 

    Dim ppApp  As Object 
    Dim ppSlide  As Object 

    On Error Resume Next 
    Set ppApp = GetObject(, "Powerpoint.Application") 
    On Error GoTo 0 

    If ppApp Is Nothing Then 
     Set ppApp = CreateObject("Powerpoint.Application") 
     ppApp.Visible = True 
     ppApp.Presentations.Add 
    End If 


    Dim MySheets, i As Long 

    MySheets = Array(Sheet44, Sheet45, Sheet46, Sheet47, Sheet43, Sheet42, Sheet41, Sheet40, Sheet48) 'these are sheet codenames not sheet name. 
    MyRanges = Array("A1:Q45", "A1:Q45", "A1:Q45", "A1:Q45", "A1:Q45", "A1:Q45", "A1:Q45", "A1:Q45", "A1:Q45") 

    For i = LBound(MySheets) To UBound(MySheets) 
     If ppApp.ActivePresentation.Slides.Count = 0 Then 
      Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, 12) 'ppLayoutBlank 
     Else 
      ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, 12 
      Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count) 
     End If 
     Copy_Paste_to_PowerPoint ppApp, ppSlide, MySheets(i), MySheets(i).Range(MyRanges(i)), xl_Bitmap 
    Next 




End Sub 


Sub Copy_Paste_to_PowerPoint(ByRef ppApp As Object, ByRef ppSlide As Object, ByVal ObjectSheet As Worksheet, _ 
            ByRef PasteObject As Object, Optional ByVal Paste_Type As PasteFormat) 


    Dim PasteRange  As Boolean 
    Dim objChart  As ChartObject 
    Dim lngSU   As Long 

    Select Case TypeName(PasteObject) 
     Case "Range" 
      If Not TypeName(Selection) = "Range" Then Application.GoTo PasteObject.Cells(1) 
      PasteRange = True 
     Case "Chart": Set objChart = PasteObject.Parent 
     Case "ChartObject": Set objChart = PasteObject 
     Case Else 
      MsgBox PasteObject.Name & " is not a valid object to paste. Macro will exit", vbCritical 
      Exit Sub 
    End Select 

    With Application 
     lngSU = .ScreenUpdating 
     .ScreenUpdating = 0 
    End With 

    ppApp.ActiveWindow.View.GotoSlide ppSlide.SlideNumber 

    On Error GoTo -1: On Error GoTo 0 
    DoEvents 

    If PasteRange Then 
     If Paste_Type = xl_Bitmap Then 
      '//Paste Range as Picture 
      PasteObject.CopyPicture Appearance:=1, Format:=-4147 
      ppSlide.Shapes.Paste.Select 
     ElseIf Paste_Type = xl_HTML Then 
      '//Paste Range as HTML 
      PasteObject.Copy 
      ppSlide.Shapes.PasteSpecial(8, link:=1).Select 'ppPasteHTML 
     ElseIf Paste_Type = xl_Link Then 
      '//Paste Range as Linked 
      PasteObject.Copy 
      ppSlide.Shapes.PasteSpecial(0, link:=1).Select 'ppPasteDefault 
     End If 
    Else 
     If Paste_Type = xl_Link Then 
      '//Copy & Paste Chart Linked 
      objChart.Chart.ChartArea.Copy 
      ppSlide.Shapes.PasteSpecial(link:=True).Select 
     Else 
      '//Copy & Paste Chart Not Linked 
      objChart.Chart.CopyPicture Appearance:=1, Size:=1, Format:=2 
      ppSlide.Shapes.Paste.Select 
     End If 
    End If 

    '//Center pasted object in the slide 
    With ppApp.ActiveWindow 
     If .Height > .Selection.ShapeRange.Height Then 
      .Selection.ShapeRange.LockAspectRatio = True 
      .Selection.ShapeRange.Height = .Height * 0.82 
     End If 
     If .Selection.ShapeRange.Width > 708 Then 
      .Selection.ShapeRange.LockAspectRatio = True 
      .Selection.ShapeRange.Width = 708 
     End If 
     .Selection.ShapeRange.Align msoAlignCenters, True 
     .Selection.ShapeRange.Align msoAlignMiddles, True 
    End With 

    With Application 
     .CutCopyMode = False 
     .ScreenUpdating = lngSU 
    End With 

    'AppActivate ("Microsoft Excel") 

End Sub 

Answer 1

当您复制Copy_Paste_to_PowerPoint函数时，忘记复制枚举。

Public Enum PasteFormat 
    xl_Link = 0 
    xl_HTML = 1 
    xl_Bitmap = 2 
End Enum 

你是否从here之类的地方得到它？它看起来有点像那个版本。它看起来像你或你从谁那里得到的东西，剥离了归属。你真的应该把你的代码片段的来源放在那里。它不仅是像stackoverflow这样的地方的合法要求，而且对于弄清楚代码是做什么，来自哪里，以及可能会出现什么错误，也是非常有用的。