Macro Copy Excel Chart Sheet to PowePoint - Mod of Jon Peltier code

  • Thread starter Thread starter Frank Hayes
  • Start date Start date
F

Frank Hayes

Jon Peltier wrote a great macro to copy an Excel Chart on a worksheet (not a
chart sheet) to an open PowerPoint presentation. I had need of a slightly
different version and modified the code to the state below to a) work with a
Chart sheet and b) preserve the size of the title font on the recopy.

My issue is that my original chart sheet is driven via a combo box. I
choose an item in the combo box (e.g. "Asia" or "Europe") and the chart
automatically redisplays with that data. My chart title also changes
dynamically depending on the combo box choice, i.e, the chart title is
"=DataSheet!$B$5". When the macro below executes, it pastes a static
version of the title text back into the excel chart sheet instead of the
formula.. Can someone help me with the code to copy the dynamic link back
instead, such that the next time I change the combo box, the title will
refresh as well?

I would also like this single macro to work with charts where the title is
text, not a formula.

Thanks for any help

Frank


Sub SingleChartAndTitleToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

' This is a modification of code written by Jon Peltier found at
' http://peltiertech.com/Excel/XL_PPT.html
' the modification was made to work with a chart on a chart sheet instead of
' a chart in a worksheet. In addition, the code was changed to restore the
' title font size back to its original size instead of the default.

' Modified by Frank Hayes

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim sTitle
Dim sTitleSize As Integer

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

With ActiveChart

' get chart title
If .HasTitle Then
sTitle = .ChartTitle.Text
sTitleSize = .ChartTitle.Font.Size
Else
sTitle = ""
End If

' remove title (or it will be redundant)
.HasTitle = False

' copy chart as a picture
.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' restore title
If Len(sTitle) > 0 Then
.HasTitle = True
.ChartTitle.Text = sTitle
.ChartTitle.Font.Size = sTitleSize
End If

End With

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
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
.Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
End With

MsgBox "Chart Copied To PowerPoint Presentation"

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub
 
While you can set the title of a chart text element, using R1C1 syntax like
this:

ActiveChart.ChartTitle.Text = "='Dot Data'!R6C3"

there seems to be no way to access this formula, that is, it's write-only.
However, by relying on our old old friend, XLM macro language, we can still
find the formula:

Sub ShowChartTitleFormula()
Dim sFmla As String
sFmla = ExecuteExcel4Macro("GET.FORMULA(""TITLE"")")
MsgBox sFmla
End Sub

If the title contains text only, sFmla contains this text. If the title
contains a formula, sFmla contains the formula. Note: the chart must be the
active chart.

so activate the chart and change this line

sTitle = .ChartTitle.Text

to

sTitle = ExecuteExcel4Macro("GET.FORMULA(""TITLE"")")


- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
Peltier Technical Services, Inc. - http://PeltierTech.com
_______
 
Jon,

Thank you for the original code and the upgrade. I appreciate your taking
the time to look at it.

Frank
 
Jon,

I am running into a Run-time error '13': Type mismatch on the sTitle =
ExecuteExcel4Macro("GETFORMULA(""TITLE"")") line. When I debug and hover
over sTitle in the the failed line of code is see ... sTitle = ""

On my chart sheet the Chart Title box is ... ='Chart Data'!$C$5 ... and is
displaying the string ... EUROPE

I have also added the ActiveSheet.Activate line and msgbox to make sure I
was on the right worksheet (although it seems redundant to me since I am
calling the macro from that chart sheet.

I tried to test this using the example macro you provided and I am getting
the same error. Here is the current code I am running. Any guidance? I am
running Excel 2003 SP2 on XP.


Sub ShowChartTitleFormula()
Dim sTitle As String
ActiveSheet.Activate
MsgBox ActiveSheet.Name
sTitle = ExecuteExcel4Macro("GETFORMULA(""TITLE"")")
MsgBox sTitle
End Sub

' **************************

Sub SingleChartAndTitleToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

' This is a modification of code written by Jon Peltier found at
' http://peltiertech.com/Excel/XL_PPT.html
' the modification was made to work with a chart on a chart sheet instead of
' a chart in a worksheet. In addition, the code was changed to restore the
' title font size back to its original size instead of the default.

' Modified by Frank Hayes

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim sTitle As String
Dim sTitleSize As Integer

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

ActiveSheet.Activate
MsgBox ActiveSheet.Name

With ActiveChart

' get chart title
If .HasTitle Then
' sTitle = .ChartTitle.Text
sTitle = ExecuteExcel4Macro("GETFORMULA(""TITLE"")")
sTitleSize = .ChartTitle.Font.Size
MsgBox sTitle

Else
sTitle = ""
End If

' remove title (or it will be redundant)
.HasTitle = False

' copy chart as a picture
.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' restore title
If Len(sTitle) > 0 Then
.HasTitle = True
.ChartTitle.Text = sTitle
.ChartTitle.Font.Size = sTitleSize
End If

End With

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
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
.Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
End With

MsgBox "Chart Copied To PowerPoint Presentation"

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub
 
You're missing a dot,
change GETFORMULA to GET.FORMULA

Regards,
Peter T

Jon,

I am running into a Run-time error '13': Type mismatch on the sTitle =
ExecuteExcel4Macro("GETFORMULA(""TITLE"")") line. When I debug and hover
over sTitle in the the failed line of code is see ... sTitle = ""
Click to expand...
If .HasTitle Then
' sTitle = .ChartTitle.Text
sTitle = ExecuteExcel4Macro("GETFORMULA(""TITLE"")")
sTitleSize = .ChartTitle.Font.Size
MsgBox sTitle
Click to expand...
<snip>
 
Peter and Jon,
Thank you both for the help.

Here is the revised code for anyone who wants it.

Sub SingleChartAndTitleToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

' This is a modification of code written by Jon Peltier found at
' http://peltiertech.com/Excel/XL_PPT.html
' the modification was made to work with a chart on a chart sheet instead of
' a chart in a worksheet. In addition, the code was changed to restore the
' title font size back to its original size instead of the default.

' Modified by Frank Hayes

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim sTitle As String
Dim sTitleText As String
Dim sTitleSize As Integer

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

ActiveSheet.Activate

With ActiveChart

' get chart title
If .HasTitle Then
sTitleText = .ChartTitle.Text
sTitle = ExecuteExcel4Macro("GET.FORMULA(""TITLE"")")
sTitleSize = .ChartTitle.Font.Size
Else
sTitle = ""
End If

' remove title (or it will be redundant)
.HasTitle = False

' copy chart as a picture
.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' ' restore title
If Len(sTitle) > 0 Then
.HasTitle = True
.ChartTitle.Text = sTitle
.ChartTitle.Font.Size = sTitleSize
End If

End With

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
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
.Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitleText
End With

MsgBox "Chart Copied To PowerPoint Presentation"

Application.Calculate

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub
 
Back
Top