Okay. i have been using the attached code for some time without issues in my files. However, within the past few days, I have been getting a run time error that is very random in its appearance. The code below is simplified to create two slides in PowerPoint, where one Excel table becomes one PowerPoint slide upon running the macro. I repeat it several times to create approximately 8 slides with various sizing requirements. The error I receive appears at random, and sometimes not at all. Sometimes after slide 1, sometime after slide 6, and not always. Any guidance on fixing this issue, or simplifying the code would be appreciated.
ERROR MESSAGE RECEIVED:
Run-time error -2147188160 (80048240)
shapes.pastespecial invalid request. the specified data type is unavailable
The Debug option points me to this every time it happens: mySlide.Shapes.PasteSpecial DataType:=2
But that doesn't make sense to me since sometimes it creates slides using the same requirements, and randomly stops. I don't know if I need to slow the slide creation process down with some kind of wait period between each slide creation or something else is causing this issue. Or do I need to somehow make PowerPoint visible on every slide creation.
I am at my wits end trying to correct this.
Appreciate any advice in advance.
</acct></client>
ERROR MESSAGE RECEIVED:
Run-time error -2147188160 (80048240)
shapes.pastespecial invalid request. the specified data type is unavailable
The Debug option points me to this every time it happens: mySlide.Shapes.PasteSpecial DataType:=2
But that doesn't make sense to me since sometimes it creates slides using the same requirements, and randomly stops. I don't know if I need to slow the slide creation process down with some kind of wait period between each slide creation or something else is causing this issue. Or do I need to somehow make PowerPoint visible on every slide creation.
I am at my wits end trying to correct this.
Code:
Sub PowerPt_VRB_CompactDash()
' PURPOSE: CREATE REVIEW PACKET
Dim NewName As String
Dim fpath As String
Dim nm As Name
'INPUT NAME BOX FOR NEW FILE
NewName = InputBox("REQUIRED NAMING FORMAT:" & vbCr & _
" " & vbCr & _
"<<client name="">>_<<acct ref#="">>_YYYY.MM.DD_v#_Review Doc" & vbCr & _
" " & vbCr & _
"EX: GBR Inc_006410000027sf7_2018.09.01_ v2.0_Review Doc " & vbCr & _
" " & vbCr & _
"Adjust Input Box as needed, based on Naming Requirements demonstrated above:", "Name Review Doc File", Range("Title_Review Doc").Value)
If NewName = vbNullString Then Exit Sub
'MESSAGE BOX TO CREATE NEW FILE
If MsgBox("New Review slides will be Saved in Same Location as Your Current Tool." & vbCr & _
"Slide details will be pasted as objects. All formulas/links removed." & vbCr & _
" " & vbCr & _
"(May Require 1-2 Minutes to complete - Remain Patient)" _
, vbYesNo, "Create Compact Dash Slide?") = vbNo Then Exit Sub
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShapeRange As Object
If ActiveWorkbook.Name <> ThisWorkbook.Name Then End
'CREATE POWERPOINT INSTANCE
On Error Resume Next
'POWERPOINT OPEN?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'CLEAR ALL ERRORS
Err.Clear
'OPEN POWERPOINT, IF NOT
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'PROCESS IF POWERPOINT NOT AVAILABLE
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'MAKE POWERPOINT VISIBLE AND ACTIVE
PowerPointApp.Visible = True
PowerPointApp.Activate
'CREATE NEW PRESENTATION
Set myPresentation = PowerPointApp.Presentations.Add
myPresentation.PageSetup.SlideSize = 2
'CREATE NEW PRESENTATION SLIDE: 11 = ppLayoutTitleOnly
Set mySlide = myPresentation.slides.Add(1, 11)
'COPY EXCEL RANGE
Range("Compact Review").Copy
'PASTE TO POWERPOINT SLIDE, SET TYPE 2 = ppPasteEnhancedMetafile AND POSITION 1 = ppAlignLeft
mySlide.Shapes.PasteSpecial DataType:=2
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
myShapeRange.Left = 35
myShapeRange.Top = 75
myShapeRange.ScaleHeight 1.05, msoFalse
myShapeRange.ScaleWidth 1.3, msoFalse
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Text = "Financial Analysis - Compact Review"
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Name = "Arial"
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Size = 22
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Bold = True
mySlide.Shapes.Title.ScaleHeight 0.3, msoFalse
mySlide.Shapes.Title.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = 1
'CLEAR CLIPBOARD
Application.CutCopyMode = False
'CREATE NEW PRESENTATION SLIDE: 11 = ppLayoutTitleOnly
Set mySlide = myPresentation.slides.Add(2, 11)
'COPY EXCEL RANGE
Range("Detail Review").Copy
'PASTE TO POWERPOINT SLIDE, SET TYPE 2 = ppPasteEnhancedMetafile AND POSITION 1 = ppAlignLeft
mySlide.Shapes.PasteSpecial DataType:=2
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
myShapeRange.Left = 35
myShapeRange.Top = 65
myShapeRange.ScaleHeight 0.9, msoFalse
myShapeRange.ScaleWidth 1.15, msoFalse
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Text = "Financial Analysis - Detailed Review"
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Name = "Arial"
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Size = 22
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Bold = True
mySlide.Shapes.Title.ScaleHeight 0.3, msoFalse
mySlide.Shapes.Title.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = 1
'CLEAR CLIPBOARD
Application.CutCopyMode = False
'SAVE WITH NEW NAME AT FILE PATH OF ORGINIAL SOURCE
fpath = ThisWorkbook.Path & "\"
PowerPointApp.activepresentation.SaveAs Filename:=fpath & NewName & ".pptx"
'PROMPT USER OF FILE CREATION AND REVIEW
MsgBox "Review Slides of the tool have been generated. " & vbCr & _
"Slides may require resizing due to source file formatting. " & vbCr & _
"Please review/adjust slides for fit, before distribution.", vbOKOnly
End SubAppreciate any advice in advance.
</acct></client>
