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 Files
Posting Permissions
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts
Forum Rules