VBA code to group picture to export as one

RenaatS · #1 03-05-2012, 07:22 AM

I am trying to create a bit of VBA code in Powerpoint that will scroll through all shapes on one slide and group all shapes that are of the type msoPicture. Then I want to export the group as one picture.

I have tried to create a range and then apply the Group function to that range.
To create the range I am going through all shapes and add the names of the shapes that are pictures to a string (like ArrayStr = "Shape 1",'Shape 7","Shape 9"). I than enter that string into the range by using an array (like range(array(ArrayStr)).

But when I do so the systems puts " " around the string (like Range(Array(""Shape 1",'Shape 7","Shape 9"")), which makes it unreadable to the array. (at least that seems the problem to me).

Can anyone tell me how I should do this? Do I need to group using Range? How do I create an array for it?

JohnWilson · #2 03-05-2012, 09:10 AM

I struggled with this for years but it is really easy (when you know how!)

Be aware that pictures in placeholders cannot be grouped.

Code:

Sub Group_Pic()
Dim osld As Slide
Dim oshp As Shape
Set osld = ActivePresentation.Slides(1)
'make sure nothing is selected at start or they will be grouped
ActiveWindow.Selection.Unselect
For Each oshp In osld.Shapes
If oshp.Type = msoPicture Then oshp.Select Replace:=False
Next oshp
With ActiveWindow.Selection.ShapeRange
If .Count > 1 Then .Group
End With
End Sub

RenaatS · #3 03-05-2012, 10:18 AM

Hello John,

it sounds so logical!! Why did I not think of it myself???????

Thank you, I wil try it later today, but I am convinced it will work.

Renaat

JohnWilson · #4 03-05-2012, 12:40 PM

Just for the record here's how to do it with an array.

Code:

Sub Group_Pic2()
Dim osld As Slide
Dim oshp As Shape
Dim x As Integer
'using a dynamic array
Dim myray() As String
Set osld = ActivePresentation.Slides(1)
ReDim myray(1 To 1)
For Each oshp In osld.Shapes
If oshp.Type = msoPicture Then
x = x + 1
myray(x) = oshp.Name
ReDim Preserve myray(1 To UBound(myray) + 1)
End If
Next oshp
'strip the empty top value
ReDim Preserve myray(1 To UBound(myray) - 1)
If UBound(myray) > 1 Then _
osld.Shapes.Range(myray()).Group
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Powerpoint automatically changing picture size when adding a picture (2010)	One_Life	PowerPoint	7	01-20-2012 06:57 AM
"format picture" - arrows show as no line atop picture	marbeth	Word	3	07-08-2011 02:16 PM
Code to export value from ComboBox	ilkks	Word VBA	7	05-25-2011 04:06 AM
VBA code to export individual task lists to Excel	OTPM	Excel Programming	0	05-24-2011 12:23 PM
How To Export A Picture From Word?	abrogard	Drawing and Graphics	0	08-10-2009 06:27 PM