Consulting

Results 1 to 7 of 7

Thread: How to debug the error?

  1. #1

    How to debug the error?

    Hi anyone can help me to debug the error? I have tried for few weeks but notable to figure out why.
    The function of macro in this file is used to copy the chart from excel to presentation slides. I saved the presentation slides template at desktop and copy the link to the excel macro file.
    When running the 1st time macro, it's able to works well. After close the presentation file and re-run again the macro, the error message prompted said run time error. I have no idea how to debug the error. Hope anyone can help me?


    Sub Xls2Ppt()
    Dim objPPT As Object
    Dim Shapes As Object


    Dim pptApp As Object
    Dim pptPres As Object
    Dim pptSlide As Object
    Dim pptShape As Object


    Dim MacroFile As String
    Dim strTemplate As String
    Dim strSheet As String
    Dim strTitle As String


    Dim intTotalSlide As Integer
    Dim i As Integer
    Dim j As Integer


    Dim SlideCount As Long


    MacroFile = ActiveWorkbook.Name
    strTemplate = Range("C4")
    strSheet = Range("C5")
    intTotalSlide = LastRow - 5


    Set objPPT = CreateObject("PowerPoint.Application")
    objPPT.Visible = True
    objPPT.Presentations.Open strTemplate


    Set pptApp = GetObject(, "Powerpoint.Application")
    Set pptPres = pptApp.ActivePresentation
    pptApp.ActiveWindow.ViewType = ppViewSlide

    j = pptPres.Slides.Count 'count slides
    j = 2
    i = 6

    Windows(MacroFile).Activate
    Sheets("Macro").Select
    strSheet = Range("C" & i)
    strTitle = Range("D" & i)
    Sheets(strSheet).Select


    ' 1st slide- Q1
    '********************************
    Windows(MacroFile).Activate
    Sheets("Macro").Select
    strSheet = Range("C" & i)
    strTitle = Range("D" & i)
    Sheets(strSheet).Select
    '*********************************


    'Copy Q1
    'Range("D3", "L" & Sheet6.Range("F65536").End(xlUp).Row).Select
    Range("D2:K24").Select
    Selection.Copy

    SlideCount = pptPres.Slides.Count
    Set pptSlide = pptPres.Slides.Add(j, ppLayoutTitleOnly)
    pptApp.ActiveWindow.View.GotoSlide pptSlide.SlideIndex
    pptSlide.Shapes.PasteSpecial ppPasteBitmap

    With pptSlide
    .Shapes(1).TextFrame.TextRange.Text = strTitle
    End With

    pptSlide.Shapes(pptSlide.Shapes.Count).Select
    Set sr = pptApp.ActiveWindow.Selection.ShapeRange
    sr.Align msoAlignMiddles, True
    pptApp.ActiveWindow.Selection.ShapeRange.Top = 120

    sr.ScaleHeight 0.9, msoTrue
    sr.ScaleWidth 0.9, msoTrue

    sr.Left = 120



    '2nd slide - Q2
    '************************************
    j = j + 1
    i = i + 1
    Windows(MacroFile).Activate
    Sheets("Macro").Select
    strSheet = Range("C" & i)
    strTitle = Range("D" & i)
    Sheets(strSheet).Select
    '*************************************



    'Copy Q2
    'Range("D3", "L" & Sheet6.Range("F65536").End(xlUp).Row).Select
    Range("D28:K49").Select
    Selection.Copy

    SlideCount = pptPres.Slides.Count
    Set pptSlide = pptPres.Slides.Add(j, ppLayoutTitleOnly)
    pptApp.ActiveWindow.View.GotoSlide pptSlide.SlideIndex
    pptSlide.Shapes.PasteSpecial ppPasteBitmap

    With pptSlide
    .Shapes(1).TextFrame.TextRange.Text = strTitle
    End With

    pptSlide.Shapes(pptSlide.Shapes.Count).Select
    Set sr = pptApp.ActiveWindow.Selection.ShapeRange
    sr.Align msoAlignMiddles, True
    pptApp.ActiveWindow.Selection.ShapeRange.Top = 120

    sr.ScaleHeight 0.9, msoTrue
    sr.ScaleWidth 0.9, msoTrue

    sr.Left = 120


    '3 slide - Q3
    '************************************
    j = j + 1
    i = i + 1
    Windows(MacroFile).Activate
    Sheets("Macro").Select
    strSheet = Range("C" & i)
    strTitle = Range("D" & i)
    Sheets(strSheet).Select
    '*************************************



    'Copy Q3
    'Range("D3", "L" & Sheet6.Range("F65536").End(xlUp).Row).Select
    Range("D55:K76").Select
    Selection.Copy

    SlideCount = pptPres.Slides.Count
    Set pptSlide = pptPres.Slides.Add(j, ppLayoutTitleOnly)
    pptApp.ActiveWindow.View.GotoSlide pptSlide.SlideIndex
    pptSlide.Shapes.PasteSpecial ppPasteBitmap

    With pptSlide
    .Shapes(1).TextFrame.TextRange.Text = strTitle
    End With

    pptSlide.Shapes(pptSlide.Shapes.Count).Select
    Set sr = pptApp.ActiveWindow.Selection.ShapeRange
    sr.Align msoAlignMiddles, True
    pptApp.ActiveWindow.Selection.ShapeRange.Top = 120

    sr.ScaleHeight 0.9, msoTrue
    sr.ScaleWidth 0.9, msoTrue

    sr.Left = 120



    End




    End Sub
    Attached Images Attached Images
    Attached Files Attached Files

  2. #2
    VBAX Regular
    Joined
    Nov 2020
    Location
    Swansea,South Wales,UK
    Posts
    6
    Location
    How about closing the object and releasing it?

  3. #3
    Sorry, I do not understand your question. Do you mean close the power point file? I did not open the power point file when execute the macro.

  4. #4
    Assuming that strTemplate includes the full path to the presentation that particular error should not occur. As you appear to be using late binding to PowerPoint you will need to use the numeric values of PP specific commands. Without access to the workbook and the presentation I cannot validate the rest of your code, but the following should get you closer to your target.
    Option Explicit
    
    Sub Xls2Ppt()
    Dim objPPT As Object
    Dim Shapes As Object
    Dim sR As ShapeRange
    
    
    Dim pptPres As Object
    Dim pptSlide As Object
    Dim pptShape As Object
    
    
    
    
    Dim MacroFile As String
    Dim strTemplate As String
    Dim strSheet As String
    Dim strTitle As String
    
    
    
    
    Dim intTotalSlide As Integer
    Dim i As Integer
    Dim j As Integer
    Dim LastRow As Integer
    
    
    Dim SlideCount As Long
    
    
    
    
        MacroFile = ActiveWorkbook.Name
        strTemplate = Range("C4")
        strSheet = Range("C5")
        LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
        intTotalSlide = LastRow - 5
    
    
    
    
        On Error Resume Next
        Set objPPT = GetObject(, "Powerpoint.Application")
        If Err Then
            Set objPPT = CreateObject("PowerPoint.Application")
        End If
        On Error GoTo 0
        objPPT.Visible = True
        objPPT.Presentations.Open strTemplate
        objPPT.ActiveWindow.ViewType = 1
    
    
        
        j = objPPT.Slides.Count    'count slides
        j = 2
        i = 6
    
    
        Windows(MacroFile).Activate
        Sheets("Macro").Select
        strSheet = Range("C" & i)
        strTitle = Range("D" & i)
        Sheets(strSheet).Select
    
    
    
    
        ' 1st slide- Q1
        '********************************
        Windows(MacroFile).Activate
        Sheets("Macro").Select
        strSheet = Range("C" & i)
        strTitle = Range("D" & i)
        Sheets(strSheet).Select
        '*********************************
    
    
    
    
        'Copy Q1
        'Range("D3", "L" & Sheet6.Range("F65536").End(xlUp).Row).Select
        Range("D2:K24").Select
        Selection.Copy
    
    
        SlideCount = pptPres.Slides.Count
        Set pptSlide = pptPres.Slides.Add(j, 11)
        objPPT.ActiveWindow.View.GotoSlide pptSlide.SlideIndex
        pptSlide.Shapes.PasteSpecial 1
    
    
        With pptSlide
            .Shapes(1).TextFrame.TextRange.Text = strTitle
        End With
    
    
        pptSlide.Shapes(pptSlide.Shapes.Count).Select
        Set sR = objPPT.ActiveWindow.Selection.ShapeRange
        sR.Align msoAlignMiddles, True
        objPPT.ActiveWindow.Selection.ShapeRange.Top = 120
    
    
        sR.ScaleHeight 0.9, msoTrue
        sR.ScaleWidth 0.9, msoTrue
    
    
        sR.Left = 120
    
    
        '2nd slide - Q2
        '************************************
        j = j + 1
        i = i + 1
        Windows(MacroFile).Activate
        Sheets("Macro").Select
        strSheet = Range("C" & i)
        strTitle = Range("D" & i)
        Sheets(strSheet).Select
        '*************************************
    
    
        'Copy Q2
        'Range("D3", "L" & Sheet6.Range("F65536").End(xlUp).Row).Select
        Range("D28:K49").Select
        Selection.Copy
    
    
        SlideCount = pptPres.Slides.Count
        Set pptSlide = pptPres.Slides.Add(j, 11)
        objPPT.ActiveWindow.View.GotoSlide pptSlide.SlideIndex
        pptSlide.Shapes.PasteSpecial 1 'ppPasteBitmap
    
    
        With pptSlide
            .Shapes(1).TextFrame.TextRange.Text = strTitle
        End With
    
    
        pptSlide.Shapes(pptSlide.Shapes.Count).Select
        Set sR = objPPT.ActiveWindow.Selection.ShapeRange
        sR.Align msoAlignMiddles, True
        objPPT.ActiveWindow.Selection.ShapeRange.Top = 120
    
    
        sR.ScaleHeight 0.9, msoTrue
        sR.ScaleWidth 0.9, msoTrue
    
    
        sR.Left = 120
    
    
    
    
        '3 slide - Q3
        '************************************
        j = j + 1
        i = i + 1
        Windows(MacroFile).Activate
        Sheets("Macro").Select
        strSheet = Range("C" & i)
        strTitle = Range("D" & i)
        Sheets(strSheet).Select
        '*************************************
        'Copy Q3
        'Range("D3", "L" & Sheet6.Range("F65536").End(xlUp).Row).Select
        Range("D55:K76").Select
        Selection.Copy
    
    
        SlideCount = pptPres.Slides.Count
        Set pptSlide = pptPres.Slides.Add(j, 11)
        objPPT.ActiveWindow.View.GotoSlide pptSlide.SlideIndex
        pptSlide.Shapes.PasteSpecial 1
    
    
        With pptSlide
            .Shapes(1).TextFrame.TextRange.Text = strTitle
        End With
    
    
        pptSlide.Shapes(pptSlide.Shapes.Count).Select
        Set sR = objPPT.ActiveWindow.Selection.ShapeRange
        sR.Align msoAlignMiddles, True
        objPPT.ActiveWindow.Selection.ShapeRange.Top = 120
    
    
        sR.ScaleHeight 0.9, msoTrue
        sR.ScaleWidth 0.9, msoTrue
    
    
        sR.Left = 120
        End
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Thanks Gmayor. However, it still stuck at "objPPT.Presentations.Open strTemplate ". The error still said nothing for strTemplate.
    attached the error message and the file.
    Attached Images Attached Images
    Attached Files Attached Files

  6. #6
    PowerPoint is not my forte however I am pretty certain that the problem is that the template doesn't exist where the sheet indicates. I have therefore trapped the missing file with a warning message.
    I am not sure about the slide layout handling of PP so I will leave you to address that, but I have fixed the issues so that at least it shouldn't crash (and doesn't here), provided the template file is present at the named location.
    Attached Files Attached Files
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    Yeahh!!... finally it's work. Thank you so much Gmayor.

Posting Permissions

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