Consulting

Results 1 to 1 of 1

Thread: VBA Code Run Time Error on Excel to Powerpoint

  1. #1
    VBAX Newbie
    Joined
    Nov 2018
    Posts
    1
    Location

    VBA Code Run Time Error on Excel to Powerpoint

    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, not sure it is the culprit though: mySlide.Shapes.PasteSpecial DataType:=2

    That issue 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 prompt PowerPoint to remain active and visible, or it is something else that is causing this issue.

    I am at my wits end trying to correct this. This is occurring in Excel '16 to PowerPoint '16

    
    
    Sub PowerPt_ReviewDoc()
    
    
    ' 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 & _
        "<>_<>_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 Sub
    
    

    Any assistance solving this issue would be greatly appreciated.
    Last edited by kanddo2; 11-27-2018 at 12:18 PM. Reason: Previous post was partial

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •