Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,836
Default Copy/Paste Charts; Define Destination of Charts in PowerPoint


I found this snippet of code on the web (thanks JP):

Sub CopyChartsIntoPowerPoint()
''' COPY SELECTED EXCEL CHARTS INTO POWERPOINT
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim pptApp As PowerPoint.Application
Dim iShapeIx As Integer, iShapeCt As Integer
Dim myShape As Shape, myChart As ChartObject
Dim bCopied As Boolean

Set pptApp = GetObject(, "PowerPoint.Application")

If ActiveChart Is Nothing Then
''' SELECTION IS NOT A SINGLE CHART
On Error Resume Next
iShapeCt = Selection.ShapeRange.Count
If Err Then
MsgBox "Select charts and try again", vbCritical, "Nothing Selected"
Exit Sub
End If
On Error GoTo 0
For Each myShape In Selection.ShapeRange
''' IS SHAPE A CHART?
On Error Resume Next
Set myChart = ActiveSheet.ChartObjects(myShape.Name)
If Not Err Then
bCopied = CopyChartToPowerPoint(pptApp, myChart)
End If
On Error GoTo 0
Next
Else
''' CHART ELEMENT OR SINGLE CHART IS SELECTED
Set myChart = ActiveChart.Parent
bCopied = CopyChartToPowerPoint(pptApp, myChart)
End If

Dim myPptShape As PowerPoint.Shape
Dim myScale As Single
Dim iShapesCt As Integer

''' BAIL OUT IF NO PICTURES ON SLIDE
On Error Resume Next
iShapesCt = pptApp.ActiveWindow.Selection.SlideRange.Shapes.Co unt
If Err Then
MsgBox "There are no shapes on the active slide", vbCritical, "No Shapes"
Exit Sub
End If
On Error GoTo 0

''' ASK USER FOR SCALING FACTOR
myScale = InputBox(Prompt:="Enter a scaling factor for the shapes
(percent)", _
Title:="Enter Scaling Percentage") / 100

''' LOOP THROUGH SHAPES AND RESCALE "PICTURES"
For Each myPptShape In pptApp.ActiveWindow.Selection.SlideRange.Shapes
If myPptShape.Name Like "Picture*" Then
With myPptShape
.ScaleWidth myScale, msoTrue, msoScaleFromBottom
.ScaleHeight myScale, msoTrue, msoScaleFromBottom
End With
End If
Next

Set myChart = Nothing
Set myShape = Nothing
Set myPptShape = Nothing
Set pptApp = Nothing
End Sub

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
oChart As ChartObject)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture,
Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

CopyChartToPowerPoint = True
End Function

That part works fine, now Im trying to define the destination of each chart
on the PPT slide. I though it may be something like this:
PowerPointConn.ActivePresentation.Slides(SlideNumb er).Shapes(1).Top = "85"
PowerPointConn.ActivePresentation.Slides(SlideNumb er).Shapes(1).Left = "85"


However, it doesn't work.

Also, my charts are named Chart1, Chart2, and Chart3 now, but in the future
the charts may be deleted and recreated, so Im wondering if there is a way
to define variables such as:

Dim MyChartObj

Then, define the destinations for these charts/objects.

Is this possible or just wishful thinking?


Regards,
Ryan---


--
RyGuy
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 6,582
Default Copy/Paste Charts; Define Destination of Charts in PowerPoint

In the function that actually pastes the chart:

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
oChart As ChartObject)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture, _
Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

CopyChartToPowerPoint = True
End Function

you can name your charts. You might want to pass the name from the calling
sub.

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
oChart As ChartObject, sShapeName as String)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture, _
Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

with oPPtApp.ActiveWindow.Selection.SlideRange.Shapes( _
oPPtApp.ActiveWindow.Selection.SlideRange.Shapes.C ount)
.Name = sShapeName
End With

CopyChartToPowerPoint = True
End Function

Alternatively, you could pass the left and top properties to the function:

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
oChart As ChartObject, dLeft as Double, dTop as Double)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture, _
Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

with oPPtApp.ActiveWindow.Selection.SlideRange.Shapes( _
oPPtApp.ActiveWindow.Selection.SlideRange.Shapes.C ount)
.Left = dLeft
.Top = dTop
End With

CopyChartToPowerPoint = True
End Function

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


"ryguy7272" wrote in message
...

I found this snippet of code on the web (thanks JP):

Sub CopyChartsIntoPowerPoint()
''' COPY SELECTED EXCEL CHARTS INTO POWERPOINT
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim pptApp As PowerPoint.Application
Dim iShapeIx As Integer, iShapeCt As Integer
Dim myShape As Shape, myChart As ChartObject
Dim bCopied As Boolean

Set pptApp = GetObject(, "PowerPoint.Application")

If ActiveChart Is Nothing Then
''' SELECTION IS NOT A SINGLE CHART
On Error Resume Next
iShapeCt = Selection.ShapeRange.Count
If Err Then
MsgBox "Select charts and try again", vbCritical, "Nothing
Selected"
Exit Sub
End If
On Error GoTo 0
For Each myShape In Selection.ShapeRange
''' IS SHAPE A CHART?
On Error Resume Next
Set myChart = ActiveSheet.ChartObjects(myShape.Name)
If Not Err Then
bCopied = CopyChartToPowerPoint(pptApp, myChart)
End If
On Error GoTo 0
Next
Else
''' CHART ELEMENT OR SINGLE CHART IS SELECTED
Set myChart = ActiveChart.Parent
bCopied = CopyChartToPowerPoint(pptApp, myChart)
End If

Dim myPptShape As PowerPoint.Shape
Dim myScale As Single
Dim iShapesCt As Integer

''' BAIL OUT IF NO PICTURES ON SLIDE
On Error Resume Next
iShapesCt = pptApp.ActiveWindow.Selection.SlideRange.Shapes.Co unt
If Err Then
MsgBox "There are no shapes on the active slide", vbCritical, "No
Shapes"
Exit Sub
End If
On Error GoTo 0

''' ASK USER FOR SCALING FACTOR
myScale = InputBox(Prompt:="Enter a scaling factor for the shapes
(percent)", _
Title:="Enter Scaling Percentage") / 100

''' LOOP THROUGH SHAPES AND RESCALE "PICTURES"
For Each myPptShape In pptApp.ActiveWindow.Selection.SlideRange.Shapes
If myPptShape.Name Like "Picture*" Then
With myPptShape
.ScaleWidth myScale, msoTrue, msoScaleFromBottom
.ScaleHeight myScale, msoTrue, msoScaleFromBottom
End With
End If
Next

Set myChart = Nothing
Set myShape = Nothing
Set myPptShape = Nothing
Set pptApp = Nothing
End Sub

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
oChart As ChartObject)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture,
Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

CopyChartToPowerPoint = True
End Function

That part works fine, now I'm trying to define the destination of each
chart
on the PPT slide. I though it may be something like this:
PowerPointConn.ActivePresentation.Slides(SlideNumb er).Shapes(1).Top = "85"
PowerPointConn.ActivePresentation.Slides(SlideNumb er).Shapes(1).Left =
"85"


However, it doesn't work.

Also, my charts are named Chart1, Chart2, and Chart3 now, but in the
future
the charts may be deleted and recreated, so I'm wondering if there is a
way
to define variables such as:

Dim MyChartObj

Then, define the destinations for these charts/objects.

Is this possible or just wishful thinking?


Regards,
Ryan---


--
RyGuy



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,836
Default Copy/Paste Charts; Define Destination of Charts in PowerPoint

It's an honor and a pleasure to see a true Excel 'guru' respond to one of my
posts. Thanks for the info. I'm going to use it, and keep it in a safe
place.

As an alternative, I noticed the 'linking' technique works pretty well (and
it is great for non-gurus such as myself).
http://pptfaq.com/FAQ00593.htm

Thanks,
Ryan--
--
RyGuy


"Jon Peltier" wrote:

In the function that actually pastes the chart:

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
oChart As ChartObject)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture, _
Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

CopyChartToPowerPoint = True
End Function

you can name your charts. You might want to pass the name from the calling
sub.

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
oChart As ChartObject, sShapeName as String)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture, _
Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

with oPPtApp.ActiveWindow.Selection.SlideRange.Shapes( _
oPPtApp.ActiveWindow.Selection.SlideRange.Shapes.C ount)
.Name = sShapeName
End With

CopyChartToPowerPoint = True
End Function

Alternatively, you could pass the left and top properties to the function:

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
oChart As ChartObject, dLeft as Double, dTop as Double)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture, _
Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

with oPPtApp.ActiveWindow.Selection.SlideRange.Shapes( _
oPPtApp.ActiveWindow.Selection.SlideRange.Shapes.C ount)
.Left = dLeft
.Top = dTop
End With

CopyChartToPowerPoint = True
End Function

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


"ryguy7272" wrote in message
...

I found this snippet of code on the web (thanks JP):

Sub CopyChartsIntoPowerPoint()
''' COPY SELECTED EXCEL CHARTS INTO POWERPOINT
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim pptApp As PowerPoint.Application
Dim iShapeIx As Integer, iShapeCt As Integer
Dim myShape As Shape, myChart As ChartObject
Dim bCopied As Boolean

Set pptApp = GetObject(, "PowerPoint.Application")

If ActiveChart Is Nothing Then
''' SELECTION IS NOT A SINGLE CHART
On Error Resume Next
iShapeCt = Selection.ShapeRange.Count
If Err Then
MsgBox "Select charts and try again", vbCritical, "Nothing
Selected"
Exit Sub
End If
On Error GoTo 0
For Each myShape In Selection.ShapeRange
''' IS SHAPE A CHART?
On Error Resume Next
Set myChart = ActiveSheet.ChartObjects(myShape.Name)
If Not Err Then
bCopied = CopyChartToPowerPoint(pptApp, myChart)
End If
On Error GoTo 0
Next
Else
''' CHART ELEMENT OR SINGLE CHART IS SELECTED
Set myChart = ActiveChart.Parent
bCopied = CopyChartToPowerPoint(pptApp, myChart)
End If

Dim myPptShape As PowerPoint.Shape
Dim myScale As Single
Dim iShapesCt As Integer

''' BAIL OUT IF NO PICTURES ON SLIDE
On Error Resume Next
iShapesCt = pptApp.ActiveWindow.Selection.SlideRange.Shapes.Co unt
If Err Then
MsgBox "There are no shapes on the active slide", vbCritical, "No
Shapes"
Exit Sub
End If
On Error GoTo 0

''' ASK USER FOR SCALING FACTOR
myScale = InputBox(Prompt:="Enter a scaling factor for the shapes
(percent)", _
Title:="Enter Scaling Percentage") / 100

''' LOOP THROUGH SHAPES AND RESCALE "PICTURES"
For Each myPptShape In pptApp.ActiveWindow.Selection.SlideRange.Shapes
If myPptShape.Name Like "Picture*" Then
With myPptShape
.ScaleWidth myScale, msoTrue, msoScaleFromBottom
.ScaleHeight myScale, msoTrue, msoScaleFromBottom
End With
End If
Next

Set myChart = Nothing
Set myShape = Nothing
Set myPptShape = Nothing
Set pptApp = Nothing
End Sub

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
oChart As ChartObject)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture,
Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

CopyChartToPowerPoint = True
End Function

That part works fine, now I'm trying to define the destination of each
chart
on the PPT slide. I though it may be something like this:
PowerPointConn.ActivePresentation.Slides(SlideNumb er).Shapes(1).Top = "85"
PowerPointConn.ActivePresentation.Slides(SlideNumb er).Shapes(1).Left =
"85"


However, it doesn't work.

Also, my charts are named Chart1, Chart2, and Chart3 now, but in the
future
the charts may be deleted and recreated, so I'm wondering if there is a
way
to define variables such as:

Dim MyChartObj

Then, define the destinations for these charts/objects.

Is this possible or just wishful thinking?


Regards,
Ryan---


--
RyGuy




Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
copy Excel charts to PowerPoint and Word Cesar Camargos Excel Programming 0 February 16th 07 07:33 PM
Copy Charts from Excel worksheet to PowerPoint Koulla Excel Programming 3 October 30th 06 03:28 PM
Copy every 3rd cell, define destination range for paste Meltad Excel Programming 1 September 27th 06 01:46 PM
resize charts to paste into powerpoint/word k2sarah Charts and Charting in Excel 1 February 20th 06 12:15 AM
paste charts into powerpoint-misalignment k2sarah Charts and Charting in Excel 0 February 18th 06 03:51 AM


All times are GMT +1. The time now is 05:07 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"