How to debug the error?

[Vancylynn]

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

[Gasman]

How about closing the object and releasing it?

[Vancylynn]

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.

[gmayor]

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

[Vancylynn]

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.

[gmayor]

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.

[Vancylynn]

Yeahh!!:yes... finally it's work. Thank you so much Gmayor. :clap: