A
Amit Shanker
Hi,
I have the following queries with reference to the code modules below :
1) If I first run SetMyRef and then run ExcelChartsToPPT, it works fine. But
if I *call* SetMyRef from the second module the reference to Powerpoint is
not set, and the code aborts. Why is this so ?
2) How should I change my code to late binding for ExcelChartsToPPT ?
Option Explicit
Sub SetMyRef()
Dim R As Variant
For Each R In ActiveWorkbook.VBProject.References
If R.GUID = "{91493440-5A91-11CF-8700-00AA0060263B}" Then
Exit Sub
End If
Next
On Error GoTo NotFound
ActiveWorkbook.VBProject.References.AddFromGuid
"{91493440-5A91-11CF-8700-00AA0060263B}", _
Major:=2, Minor:=7
Exit Sub
NotFound:
MsgBox "CAN'T RUN THIS CODE"
End Sub
Sub ExcelChartsToPPT()
On Error GoTo ErrHandler
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideCount As Long
Dim iCht As Integer
Dim i As Integer
Dim Ans As String
Ans = MsgBox("Copy all charts in workbook to Powerpoint ?", vbYesNo +
vbQuestion, "Confirm")
If Ans = vbYes Then GoTo Proceed Else Exit Sub
Proceed:
Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True
PPApp.WindowState = ppWindowMinimized
' Create active presentation
Set PPPres = PPApp.Presentations.Add
PPPres.Slides.Add 1, ppLayoutTitle
For i = 1 To Worksheets.Count 'All worksheets with embedded charts
needing transfer to PP
For iCht = 1 To Worksheets(i).ChartObjects.Count
' copy chart as a picture
Worksheets(i).ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
'xlBitmap can also be used
' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align
msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align
msoAlignMiddles, True
End With
Next iCht
Next i
PPPres.Slides(1).Select
PPApp.WindowState = ppWindowMaximized
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
Exit Sub
ErrHandler: MsgBox "An error occurred; please re-try !", vbInformation
End Sub
Thanks,
Amit
I have the following queries with reference to the code modules below :
1) If I first run SetMyRef and then run ExcelChartsToPPT, it works fine. But
if I *call* SetMyRef from the second module the reference to Powerpoint is
not set, and the code aborts. Why is this so ?
2) How should I change my code to late binding for ExcelChartsToPPT ?
Option Explicit
Sub SetMyRef()
Dim R As Variant
For Each R In ActiveWorkbook.VBProject.References
If R.GUID = "{91493440-5A91-11CF-8700-00AA0060263B}" Then
Exit Sub
End If
Next
On Error GoTo NotFound
ActiveWorkbook.VBProject.References.AddFromGuid
"{91493440-5A91-11CF-8700-00AA0060263B}", _
Major:=2, Minor:=7
Exit Sub
NotFound:
MsgBox "CAN'T RUN THIS CODE"
End Sub
Sub ExcelChartsToPPT()
On Error GoTo ErrHandler
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideCount As Long
Dim iCht As Integer
Dim i As Integer
Dim Ans As String
Ans = MsgBox("Copy all charts in workbook to Powerpoint ?", vbYesNo +
vbQuestion, "Confirm")
If Ans = vbYes Then GoTo Proceed Else Exit Sub
Proceed:
Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True
PPApp.WindowState = ppWindowMinimized
' Create active presentation
Set PPPres = PPApp.Presentations.Add
PPPres.Slides.Add 1, ppLayoutTitle
For i = 1 To Worksheets.Count 'All worksheets with embedded charts
needing transfer to PP
For iCht = 1 To Worksheets(i).ChartObjects.Count
' copy chart as a picture
Worksheets(i).ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
'xlBitmap can also be used
' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align
msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align
msoAlignMiddles, True
End With
Next iCht
Next i
PPPres.Slides(1).Select
PPApp.WindowState = ppWindowMaximized
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
Exit Sub
ErrHandler: MsgBox "An error occurred; please re-try !", vbInformation
End Sub
Thanks,
Amit