Excell-PPT shape handling problem

[Sylvia2012]

Hey guys,

After a few tries of my own I thought I should seek enlightment from VB gurus.

I am building an application in VB which purpose is to copy designated charts from Excel and paste them to a PowerPoint presentation. The code is on Excel VB Editor but I do not have a problem to split it and run a separate part on PPT.

I have realised a rough version but it needs some finetunning. What I have done so far is to initiate a the new PPT object, browse through excel's chart objects and copy the appropriate ones and paste them to PPT slide.

My problem is that while i know how to perform the copy-paste routine and I have managed to paste the charts in a designated slide, after the pasting ends I cannot find a way to slect those pasted charts and reposition them as I want because certain slides have 2 or more pasted charts and I cannot find a way to select them and reposition them to the appropriate position within the slide. Only way I can think of it is to select them by coordinates but I would use this solution as a last resorts.

Please share thoughts or suggestions, they are more than welcome.
To skip a future post i have included my code:

Sub test1()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim i, SlideNum As Integer, strString As String
Dim limit, pathn, objcount, countTables, limitt As Integer
Dim chtobj As ChartObject
Dim ws As Worksheet



Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Open("C:\Documents and Settings\Sylvia\Desktop\test\test.ppt")

ActiveWorkbook.Activate

For Each ws In ActiveWorkbook.Worksheets

For Each chtobj In Sheets(ws.Name).ChartObjects
oname = chtobj.Name
If InStr(1, chtobj.Name, "BNChart", vbTextCompare) Then
Sheets(ws.Name).Activate
ActiveSheet.ChartObjects(oname).Activate
ActiveChart.CopyPicture Appearance:=xlScreen, _Size:=xlScreen, Format:=xlPicture

For Each obj In pptPres.Slides

With pptPres.Slides
Set pptSlide = pptPres.Slides(obj.Name)
End With

With pptSlide

For Each pptShape In pptApp.ActiveWindow.Selection.SlideRange.Shapes
If pptSlide.Shapes.Range(pptShape.Name).Name = oname Then
.Shapes.PasteSpecial ppPasteShape
GoTo Holder
End If

Next
End With
Next
End If
Holder: Next
Next

End Sub


Cheers,
Sylvia

[p45cal]

What is it you're looking for with:For Each pptShape In pptApp.ActiveWindow.Selection.SlideRange.Shapes
If pptSlide.Shapes.Range(pptShape.Name).Name = oname Then Is there a shape with the same name as the excel chart already on the slide? If so, what is that shape (its type)?

[Sylvia2012]

Hey p45cal,

Thank you for your immediate response, I am using this for loop for the following reason: The PPT template I am using has certain named shapes which I am using to identify the target slide for the chart to be pasted to. (The type is textbox i think)
So if I have lets say Chart_1 copied from excel I switch to the PPT presentation and I browse through its slide and through each shape to find the shape named Chart_1, and when this happens the chart is pasted there but not in the position I want. So, the problem is how can I reselect it and reposition it. I have tried to browse through shapes again but it is not recognised as one.

[p45cal]

I had to mess with it quite a lot to get it it (sort-of) working here, and I've removed some unnecessary code, so try:
Sub test2()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptShape As PowerPoint.Shape
Dim chtobj As ChartObject
Dim ws As Worksheet
Dim oname As String, ddd
Dim pptSlide As PowerPoint.Slide
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Open("C:\Documents and Settings\Sylvia\Desktop\test\test.ppt")
ActiveWorkbook.Activate
For Each ws In ActiveWorkbook.Worksheets
For Each chtobj In ws.ChartObjects
oname = chtobj.Name
If InStr(1, oname, "BNChart", vbTextCompare) Then
chtobj.Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
For Each pptSlide In pptPres.Slides
For Each pptShape In pptSlide.Shapes
If pptShape.Name = oname Then
With pptSlide.Shapes.PasteSpecial(ppPasteShape) 'had to take out the ppPasteShape for it to work here.
'some of the things you can do to manipulate the picture:
.Left = 10
.Top = 10
.Width = 500
.LockAspectRatio = msoFalse
.Height = 150
End With
GoTo Holder
End If
Next pptShape
Next pptSlide
End If
Holder:
Next chtobj
Next ws
End Sub
If you may have more then one chart to move around, you can set them to an object variable (ddd below) to let you move each one around independently:
Sub test3()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptShape As PowerPoint.Shape
Dim chtobj As ChartObject
Dim ws As Worksheet
Dim oname As String, ddd
Dim pptSlide As PowerPoint.Slide
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Open("C:\Documents and Settings\Sylvia\Desktop\test\test.ppt")
ActiveWorkbook.Activate
For Each ws In ActiveWorkbook.Worksheets
For Each chtobj In ws.ChartObjects
oname = chtobj.Name
If InStr(1, oname, "BNChart", vbTextCompare) Then
chtobj.Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
For Each pptSlide In pptPres.Slides
For Each pptShape In pptSlide.Shapes
If pptShape.Name = oname Then
Set ddd = pptSlide.Shapes.PasteSpecial(ppPasteShape) 'had to take out the ppPasteShape for it to work here.
ddd.Left = 10
ddd.Top = 10
ddd.Width = 500
ddd.LockAspectRatio = msoFalse
ddd.Height = 150
GoTo Holder
End If
Next pptShape
Next pptSlide
End If
Holder:
Next chtobj
Next ws
End Sub

[Sylvia2012]

Dear p45cal,

Thank you for your valuable input, your second bit pretty much does the trick of selecting the chart but my problem still remains. If I have 2 charts in a slide how do I reposition them in the way I want since not all slides contain 2 charts so we could not apply the same formula to the collection.

Best,
S.

[Sylvia2012]

I thought of the pickup-apply method but it doesn't seem to work for those objects, maybe it doesn't work with positions only with the format.
Of course I can always write a second code part, probably in PPT VB Editor and run it separately so I can fix the positions, but I do want to keep it as generic as possible.

[p45cal]

You could, each time you paste a chart into a slide, add that chart as an object to an array. If you add a line:
Dim AllMyCharts()
among the Dim statements at the top of the procedure, then delete:
Set ddd = pptSlide.Shapes.PasteSpecial(ppPasteShape) 'had to take out the ppPasteShape for it to work here.
ddd.Left = 10
ddd.Top = 10
ddd.Width = 500
ddd.LockAspectRatio = msoFalse ddd.Height = 150 and replace it with:
i = i + 1
ReDim Preserve AllMyCharts(1 To i)
Set AllMyCharts(i) = pptSlide.Shapes.PasteSpecial(ppPasteShape)
Now when the end of the procedure (as it stands above) is reached you'll have all the added charts in all the slides in a single array. Then it's a case of running through each slide again and determining which and how many charts have been added to each.
The following, which you should paste directly before End Sub, does this:
Dim AllChartsOnOneSlide()
For Each pptSlide In pptPres.Slides
Erase AllChartsOnOneSlide
i = 0
For Each cht In AllMyCharts
If cht.Parent.Name = pptSlide.Name Then
i = i + 1
ReDim Preserve AllChartsOnOneSlide(1 To i)
Set AllChartsOnOneSlide(i) = cht
End If
Next cht
If i > 0 Then
For Each chat In AllChartsOnOneSlide
'in this loop you know how many charts need to be arranged (i)
'and this loop will cycle through them one at a time (chat)
'from this you can work out where you want to position them.
'(Lots of arithmetic). It's better not to select them.
'chat.top = 100 etc.
Next chat
End If
Next pptSlide
The above snippet runs through each slide, where it checks all the charts in AllMyCharts and only puts those which are on the same slide into another array called AllChartsOnOneSlide, incrementing the value of i each time it finds one. Then if it has found at least one, it will run through that new array allowing you to reposition them.

I can't test this thoroughly as I'm not going to go to the lengths of reproducing your set up fully.

[Sylvia2012]

p45cal,

Once again, that is brilliant! I will try and implement this on my own setup and let you know of the outcome.
By the way, since you seem lile you know your way around VBA i wanted to ask you this: I am using this bit of code here to match the chart with the appropriate slide
For Each pptSlide In pptPres.Slides
For Each pptShape In pptSlide.Shapes
If pptShape.Name = oname Then
With pptSlide.Shapes.PasteSpecial
I have named several textboxes on each slide with the same name as the object being copied and i am trying to match those to determine the paste location. Is there a way to paste to a specific placeholder and/or copy-paste its position settings to the newly pasted chart?

Thnaks,
S.

[p45cal]

Powerpoint version?

[Sylvia2012]

MS PPT 2002 (10.6858.6858) SP3 :fright:

[p45cal]

Right, I think PPT 2002 is similar to 2003 which I have.
I hardly use ppt but we can muddle through. I note from internet searches that the behaviour in ppt when inserting images varies greatly from version to version - especially when it comes to resizing images automatically when they're inserted.
http://www.pcreview.co.uk/forums/geometric-size-bitmap-pasted-into-powerpoint-2003-a-t2464497.html

http://www.pcreview.co.uk/forums/copy-paste-problem-powerpoint-2003-a-t2169911.html

This link talks about automatically putting things into placeholders:
http://www.pptfaq.com/FAQ00621_PowerPoint_unexpectedly_puts_content_into_placeholders.htm

So in your version, does a placeholder automatically get added when you insert or paste a graphic? If so can you delete the graphic and keep the placeholder. If so it'd be a case of renaming the placeholder, putting it into a default position on the slide. THEN, you need to record a macro (in ppt) of your pasting a new image into that placeholder, pasting that code here for incorporation into the excel macro.

If none of this works then we may have to continue as before.

I don't recognise pickup/apply - what is it?


Edit post-posting:
I see that you've also asked this question here:
http://www.vbaexpress.com/forum/showthread.php?t=40578
Have you also cross posted elsewhere? If so can you say where so that I can check you haven't had a suitable answer there so I don't have to start working on a solution that you already have?

[Sylvia2012]

Exactly, that's the problem now.
Even though im specifying the new objects dimensions pasting is not done in such a way.
Do you know if we can apply the msoFillpicture to shapes, because the pasting is kind of random.
That's the only other place I asked, sorry for the inconvenience

Thanks

[p45cal]

Exactly, that's the problem now. 'that'? I'm not clear.


Even though im specifying the new objects dimensions pasting is not done in such a way. 'such a way'? What way? Perhaps some code here?


Do you know if we can apply the msoFillpicture to shapes, because the pasting is kind of random.No I don't.


Again:
1. So in your version, does a placeholder automatically get added when you insert or paste a graphic?
2. If so can you delete the graphic and keep the placeholder?

If so it'd be a case of renaming the placeholder, putting it into a default position on the slide. THEN, you need to record a macro (in ppt) of your pasting a new image into that placeholder,
3. pasting that code here for incorporation into the excel macro.

4. I don't recognise pickup/apply - what is it?