[英]VBA Excel to PPT export
I'm trying to transfer some code from one workbook to another and I'm having trouble figuring out why it's not working. 我正在尝试将一些代码从一个工作簿转移到另一个工作簿,但是我很难弄清为什么它不起作用。 I transferred the sheets into the new workbook and made the necessary updates in the code to reference the correct sheets. 我将工作表转移到新的工作簿中,并在代码中进行了必要的更新以引用正确的工作表。 Everything else between the workbooks is consistent, but I keep receiving a compile error : User-defined type not defined. 工作簿之间的其他所有内容都是一致的,但是我一直收到编译错误:未定义用户定义的类型。 I tried debugging but I'm not sure what it's pointing to. 我尝试调试,但不确定它指向的是什么。 Thanks in advance. 提前致谢。
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
When you copied that Copy_Paste_to_PowerPoint function you forgot to copy the enum. 当您复制那个Copy_Paste_to_PowerPoint函数时,您忘记了复制枚举。
Public Enum PasteFormat
xl_Link = 0
xl_HTML = 1
xl_Bitmap = 2
End Enum
Did you get it from somewhere like here ? 你是从这里这样的地方得到的吗? It looks a bit like that version. 看起来有点像那个版本。 It looks like you or whoever you got that from stripped out the attribution. 看起来您或任何从中得到归因的人。 You really should put a comment attributing the source of your snippets in there. 您确实应该在此处添加评论片段来源的评论。 Not only is it a legal requirement of places like stackoverflow, but it's also quite useful for figuring out what code does, where it came from, and what might be wrong with it. 这不仅是对stackoverflow之类的地方的法律要求,而且对于弄清代码的作用,代码的来源以及可能出了什么问题也非常有用。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.