[英]VBA Excel to PPT export
我正在尝试将一些代码从一个工作簿转移到另一个工作簿,但是我很难弄清为什么它不起作用。 我将工作表转移到新的工作簿中,并在代码中进行了必要的更新以引用正确的工作表。 工作簿之间的其他所有内容都是一致的,但是我一直收到编译错误:未定义用户定义的类型。 我尝试调试,但不确定它指向的是什么。 提前致谢。
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
当您复制那个Copy_Paste_to_PowerPoint函数时,您忘记了复制枚举。
Public Enum PasteFormat
xl_Link = 0
xl_HTML = 1
xl_Bitmap = 2
End Enum
你是从这里这样的地方得到的吗? 看起来有点像那个版本。 看起来您或任何从中得到归因的人。 您确实应该在此处添加评论片段来源的评论。 这不仅是对stackoverflow之类的地方的法律要求,而且对于弄清代码的作用,代码的来源以及可能出了什么问题也非常有用。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.