I have a library of eight images on my PowerPoint slide. Based on a userform input, some of the components get duplicated and renamed by adding a "1" or "2" after the original image's name so that they are differentiable. I then want to group the new images (I am building up an item from the component images). I am able to duplicate the images and line them up correctly, but I am having trouble grouping them. Note that I am not always grouping the same number of items, it is dependent on user inputs.
I receive the error "Shape (unknown member): Invalid request. To select a shape, its view must be active."
I searched and attempted to implement several strategies from the help forums but am coming up empty.
PLEASE HELP!!!
-Kevin
Part of code below because it is very long, but this is where my first problem arises:
Dim Cargo As Shape, Cargo_Dup as Shape, Chemical as Shape, Chemical_Dup as Shape
Set Cargo = ActivePresentation.Slides(2).Shapes("Cargo")
Set Chemical = ActivePresentation.Slides(2).Shapes("Chemical")
Cargo.Name = "Cargo"
Chemical.Name = "Chemical"
With ActivePresentation
Set Cargo_Dup = ActivePresentation.Slides(2).Shapes("Cargo")
With Cargo_Dup.Duplicate
.Name = "Cargo_1st"
.Left = 0
.Top = 540
End With
'CHEMICAL
If Input1 = "Chemical" Then
Set Chemical_Dup = ActivePresentation.Slides(2).Shapes("Chemical")
With Chemical_Dup.Duplicate
.Name = "Chemical" & 1
.Left = 36.74352
.Top = 540 + 0.36
End With
'''''WHERE PROBLEM ARISES'''''
ActivePresentation.Slides(2).Shapes("Cargo_1st").Select
ActivePresentation.Slides(2).Shapes("Chemical1").Select msoFalse
Set Vehicle = ActiveWindow.Selection.ShapeRange.Group
Vehicle.Name = "Vehicle"
'Elseif with a bunch for options where addition grouping occurs
I need some kind of keyboard macro to type this for me:
Never select anything unless you absolutely have to.
You nearly never absolutely have to.
You're asking how to make a view active so that you can select something.
I figure that's the wrong question.
It's more useful to know how to work with shapes WITHOUT having to select them.
Grouping shapes w/o selecting them is a bit tricky, but it can be done.
Here's an example of how you might go about this:
Sub GroupWithoutSelecting()
Dim oSl As Slide
Dim oSh As Shape
Dim aShapes() As String
Set oSl = ActivePresentation.Slides(2) ' or whichever slide you like
ReDim aShapes(1 To 1)
With oSl
For Each oSh In .Shapes
If oSh.Type <> msoPlaceholder Then ' can't group placeholders
' Substitute the real condition you want to use
' for selecting shapes to be grouped here
If oSh.Type = msoAutoShape Then
' add it to the array
aShapes(UBound(aShapes)) = oSh.Name
ReDim Preserve aShapes(1 To UBound(aShapes) + 1)
End If
End If
Next
' eliminate the last (empty) element in the array
ReDim Preserve aShapes(1 To UBound(aShapes) - 1)
' Create a shaperange from the array members and group the shaperange
.Shapes.Range(aShapes).Group
End With ' oSl
End Sub
Related
I've written some code that formats text. The code doesn't work if user has put the cursor in a shape that is part of a group of shapes, the solution for which is to ungroup the shapes.
I want to regroup the shapes after executing the formatting code.
I am able to store the underlying shapes as objects, as well as their names. But, the normal approach to grouping (using shape names) doesn't work, because there can be multiple instances of those shape names on a given slide. E.g. this doesn't work as there could be multiple instances of "textbox" on the slide:
Set TempShapeGroup = TempSlide.Shapes.Range(Array("textbox", "header", "separator")).Group
https://learn.microsoft.com/en-us/office/vba/api/powerpoint.shaperange.group
But, I have the shape objects stored in an array, the crux of which is this (the object 'TempShape' is the group of shapes):
Dim ShapesArray() As Shape
ReDim ShapesArray(1 To TempShape.GroupItems.Count)
For i = 1 To TempShape.GroupItems.Count
Set ShapesArray(i) = TempShape.GroupItems.Item(i)
Next i
So, what I want to do is recreate the group of shapes, using the array of shape objects, so something to the effect of the below would be ideal:
Set MyShapesGroup= ShapesArray.Group
But any way to group shapes using Shape objects would be fine.
TIA
Here's some starter code that you can modify into a function that'll return a reference to the paragraph that contains the current selection cursor. It doesn't really need all the debug.print stuff, of course, but that might help to illustrate the object hierarchy:
Sub WhereIsTheCursor()
Dim oRng As TextRange
Dim oParentRange As TextRange
Dim x As Long
Dim lSelStart As Long
Dim lSelLen As Long
With ActiveWindow.Selection.TextRange
' find the selection start relative to first character in shape
lSelStart = .Start
' lSelLen = .Length
Debug.Print TypeName(.Parent)
Debug.Print TypeName(.Parent.Parent)
Debug.Print TypeName(.Parent.Parent.Parent)
Debug.Print .Paragraphs.Count
Set oRng = .Characters(.Start, .Length)
Debug.Print oRng.Text
' Reference the overall shape's textrange
Set oParentRange = .Parent.Parent.TextFrame.TextRange
' For each paragraph in the range ...
For x = 1 To oParentRange.Paragraphs.Count
' is the start of the selection > the start of the paragraph?
If lSelStart > oParentRange.Paragraphs(x).Start Then
' is the start < the start + length of the paragraph?
If lSelStart < oParentRange.Paragraphs(x).Start _
+ oParentRange.Paragraphs(x).Length Then
' bingo!
MsgBox "The cursor is in paragraph " & CStr(x)
End If
End If
Next
End With
End Sub
Not sure I'm completely understanding the problem, but this may help:
If the user has selected text within a shape, it doesn't really matter whether the shape is part of a group or not. You may need to test the .Selection.Type and handle things differently depending on whether the .Type is text or shaperange. Example:
Sub FormatCurrentText()
If ActiveWindow.Selection.Type = ppSelectionText Then
With ActiveWindow.Selection.TextRange
.Font.Name = "Algerian"
End With
End If
End Sub
I'm a complete VBA newb, and the below is what I have:
Sub Align_Capability_Level()
Set myDocument = ActiveWindow.View.Slide
For Each sh In ActiveWindow.Selection.ShapeRange
sh.Name = "bigBox"
Set lilSquare = myDocument.Shapes.AddShape(msoShapeRectangle, _
Left:=sh.Left + (sh.Width - Size), Top:=sh.Top + (sh.Height - Size), Width:=Size, Height:=Size)
lilSquare.Name = "smallBox"
myDocument.Shapes.Range(Array("smallBox", "bigBox")).Group
Next
End Sub
When I select three boxes, it will group the first item in the selection, and the newly created box, but it will stop there and display this error:
The ShapeRange object must contain at least two items:
I guess your problem comes from naming. The code works for the first iteration, grouping the first shape and the first created box. In this iteration, you name the shape Bigbox and Smallbox. The code will group those two happily together.
If now you either have another shape selected or execute the code another time, you will give the next shape also the name BigBox and the new created box Smallbox. Unfortunately this is possible - however it will confuse the Group-command, this will try to group the first Bigbox and the first Smallbox-shapes - and as those are already part of a group, you get the error message.
Try the following code:
For Each sh In ActiveWindow.Selection.ShapeRange
Dim lilSquare As Shape
Set lilSquare = myDocument.Shapes.AddShape(msoShapeRectangle, _
Left:=sh.Left + (sh.Width - size), Top:=sh.Top + (sh.Height - size), Width:=size, Height:=size)
lilSquare.Name = sh.Name & "_smallBox"
myDocument.Shapes.Range(Array(sh.Name, lilSquare.Name)).Group
Next
I work from excel, and i open several powerpoint in a loop inside a directory, in vba.
While i run the macro (from excel), I make a loop within every shape inside every slides in powerpoints presentation.
I stop the macro to see if AutoShapeType = -2, and i select it in vba just to check visualy if the shape is the right shape i want.
Otherwise, if the selected shape doesn't seems right, I select it manually and I want to know how the syntaxe to get the id of the current selected shape, in order to name it.
Set PPtapp = CreateObject("Powerpoint.Application")
PPtapp.Visible = True
Dim sld As Slide
Dim numslide As Long
Dim nbslide As Long
Dim WVL_CptShape As Integer
'list of every powerpoint path
ppt = ThisWorkbook.Worksheets("Template").Range("A" & i).Value
For i = 2 To ThisWorkbook.Worksheets("Template").Range("A65536").End(xlUp).Row + 1
Set PptDoc = PPtapp.Presentations.Open(ppt)
With PptDoc
For Each sld In PptDoc.Slides
For WVL_CptShape = 1 To .Slides(sld.SlideNumber).Shapes.Count
WVL_Id = .Slides(sld.SlideNumber).Shapes(WVL_CptShape).ID
If PptDoc.Slides(sld.SlideNumber).Shapes(WVL_CptShape).AutoShapeType = -2 Then
'I select the shape to see visualy if it's a good selection and I stop the macro
PptDoc.Slides(sld.SlideNumber).Shapes(WVL_CptShape).Select
Stop
'if the selection doesnt seems right I select the right shape manualy
'Question : in vba, i want to change the name of the selected shape.
'But i don't know how to get the id of the current selected shape (see below : ID_OF_CURRENT_SHAPE_SELECTED_MANUALY)
'I would like to rename it, in order to recognize it easily next time
PptDoc.Slides(sld.SlideNumber). Shapes(ID_OF_CURRENT_SHAPE_SELECTED_MANUALY).Selection.Name = "Myshape"
end if
Next WVL_CptShapeNext
sld.Close
End With
Next
PPtapp.Quit
Set PPtapp = Nothing
Set PptDoc = PPtapp.Presentations.Open(ppt)
With PptDoc
For Each sld In PptDoc.Slides
For WVL_CptShape = 1 To sld.Shapes.Count
WVL_Id = sld.Shapes(WVL_CptShape).ID
If sld.Shapes(WVL_CptShape).AutoShapeType = -2 Then
'I select the shape to see visualy if it's a good selection and I stop the macro
sld.Shapes(WVL_CptShape).Select
Stop
' And to change the name of the shape:
sld.Shapes(WVL_CptShape).Name = "New name for shape"
' or better, in case you selected a different shape:
ActiveWindow.Selection.ShapeRange(1).Name = "New name for shape"
In this type of situation, you want to work with the shape's Index, not its ID.
Note that you can iterate through the shapes collection on a slide just as you can iterate through the slides collection in a presentation. It makes the code a lot simpler to write and to follow:
Set PptDoc = PPtapp.Presentations.Open(ppt)
With PptDoc
For Each sld In PptDoc.Slides
For each shp in sld.shapes
If shp.AutoShapeType = -2 Then
'I select the shape to see visualy if it's a good selection and I stop the macro
shp.Select
Stop
I have a PowerPoint slide with different images. I need to create VBA code in PowerPoint that recognises all these images and fades them out one by one - except for one randomly chosen image. This last image should remain until the end, then fade out and display in the middle of the slide.
I have an idea of how to do it and have experience with object oriented languages (R) but I have never used VBA before. Therefore I would be grateful for pointers on how to do any of the following in VBA:
Determine number of images on active slide
Select each image one after another and assign a counter variable as selection label (that part should work as described here)
Create "Range A" of all assigned counter variables
Select random number "x" in "Range A"
Create "Range B" of all counter variables in "Range A" EXCEPT for the random number "x"
Randomise the order of variables in "Range B"
Loop through "Range B" and fade out images whose label corresponds to the respective "Range B" variable that comes up
Fade out the image whose label corresponds to "x"
Insert the image whose label corresponds to "x" in the centre of the slide
If it is very difficult to recognise images or assign labels to those images I can also do so manually. However, it would be nicer if that could happen automatically. I would be grateful for any pointers, also in the form of links if you think that part of the above process is already described somewhere else (I'm afraid since I'm inexperienced in VBA I am not using very effective search terms).
EDIT:
Please find the solution (steps 8 and 9 are still missing)
Sub SelectionMacro()
Dim oSl As Slide
Dim oSh As Shape
Dim aArrayOfShapes() As Variant
Dim ShapeX As Shape
Dim N As Long
Dim Temp As Variant
Dim J As Long
Dim FadeEffect As Effect
Set oSl = ActivePresentation.SlideS(1)
'This section creates an array of all pictures on Slide1 called
'"aArrayOfShapes"
For Each oSh In oSl.Shapes
If oSh.Type = msoPicture Then
On Error Resume Next
Debug.Print UBound(aArrayOfShapes)
If Err.Number = 0 Then
ReDim Preserve aArrayOfShapes(1 To UBound(aArrayOfShapes) + 1)
Else
ReDim Preserve aArrayOfShapes(1 To 1)
End If
Set aArrayOfShapes(UBound(aArrayOfShapes)) = oSh
End If
Next
'This section creates a random index number within the bounds of the
'length of aArrayOfShapes and assigns the shape with that index number
'to the Shape object ShapeX
Randomize
NumberX = Int((UBound(aArrayOfShapes) - (LBound(aArrayOfShapes) - 1)) * Rnd) + LBound(aArrayOfShapes)
Set ShapeX = aArrayOfShapes(NumberX)
'This section shuffles aArrayOfShapes
For N = LBound(aArrayOfShapes) To UBound(aArrayOfShapes)
J = CLng(((UBound(aArrayOfShapes) - N) * Rnd) + N)
If N <> J Then
Set Temp = aArrayOfShapes(N)
Set aArrayOfShapes(N) = aArrayOfShapes(J)
Set aArrayOfShapes(J) = Temp
End If
Next N
'This section loops through all Shapes in aArrayOfShapes and
'fades them out one by one EXCEPT for ShapeX
For Each Shape In aArrayOfShapes
If ShapeX.Name <> Shape.Name Then
Set FadeEffect = oSl.TimeLine.MainSequence.AddEffect _
(Shape:=Shape, effectid:=msoAnimEffectFade, trigger:=msoAnimTriggerAfterPrevious)
With FadeEffect
.Timing.Duration = 0.5
.Exit = msoTrue
End With
End If
Next Shape
End Sub
In order to reset the slide to the state before running the macro (so as to be able to run it again and display another random image) the following macro needs to be run:
Sub ResetSelection()
For i = ActivePresentation.SlideS(1).TimeLine.MainSequence.Count To 1 Step -1
ActivePresentation.SlideS(1).TimeLine.MainSequence(i).Delete
Next i
End Sub
Working out the range of images shouldn't be too hard. This'll get you started.
Assigning animation to shapes can be tricky. You might be better off duplicating the slide with all the images then deleting all but a randomly chosen image.
Dim oSl As Slide
Dim oSh As Shape
' Dynamic array of shapes to hold shape references
Dim aArrayOfShapes() As Shape
Set oSl = ActiveWindow.Selection.SlideRange(1)
For Each oSh In oSl.Shapes
If oSh.Type = msoPicture Then
On Error Resume Next
Debug.Print UBound(aArrayOfShapes)
If Err.Number = 0 Then
ReDim Preserve aArrayOfShapes(1 To UBound(aArrayOfShapes))
Else
ReDim Preserve aArrayOfShapes(1 To 1)
End If
Set aArrayOfShapes(UBound(aArrayOfShapes)) = oSh
End If
Next`enter code here`
' Now you have an array containing references to all the pictures
' on the slide. You can use a random number function to return
' an index into the array to choose a picture at random.
With aArrayOfShapes(RandomNumberFunction(LBound(aArrayOfShapes), UBound(aArrayOfShapes)))
' google to find an appropriate function; they're out there
' do whatever you need to do with your shapes here
End With
I just started using VBA a few days ago. I noticed that some few commands do not seem to work on my computer and I was wondering whether this is due to my computer setup.
I am using VBA in PowerPoint 2013 on Windows 7 run via VMware Fusion (virtual machine) on MacOSX. I need to create a dynamic reference to the active slide, but several way of doing so broke my code:
Set oSl = Application.ActiveWindow.View.Slide
(as suggested here)
Set oSl = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideNumber)
(as suggested here)
Set oSl = ActiveWindow.Selection.SlideRange.SlideIndex
(as suggested here)
None of these worked for me. Since I just started using VBA I simply inserted Message Boxes after different parts of the code, and looked at when the boxes where no longer triggered - in this case always after the "oSl =" line that I replaced with the various other approaches delineated above. Additionally,
Set oSl = ActiveWindow.Selection.SlideRange(1)
also broke my code (as discussed here)
What DID work so far was
Set oSl = ActivePresentation.SlideS(1)
All the methods above that didn't work (but should) contain "ActiveWindow". It would be great if you could advise on whether there are errors in my approach to selecting the active slide or whether the issue might be that VBA can't access the "ActiveWindow" properly because my PowerPoint runs on a virtual machine. Should that be the case, is there another way to select the currently active slide without using ActiveWindow?
EDIT: I am trying to apply this to the following code in PowerPoint. Basically what I want to do is replace the line "oSl = ActivePresentation.SlideS(1)" with a line of code that won't always target slide 1 but whichever slide is currently active. My question is not so much HOW to do this - there are plenty of instructions on how to do it online. My question is WHY these approaches are not working for me.
Sub SelectionMacro()
Dim oSl As Slide
Dim oSh As Shape
Dim aArrayOfShapes() As Variant
Dim ShapeX As Shape
Dim N As Long
Dim Temp As Variant
Dim J As Long
Dim FadeEffect As Effect
Set oSl = ActivePresentation.SlideS(1)
'This section creates an array of all pictures on Slide1 called
'"aArrayOfShapes"
For Each oSh In oSl.Shapes
If oSh.Type = msoPicture Then
On Error Resume Next
Debug.Print UBound(aArrayOfShapes)
If Err.Number = 0 Then
ReDim Preserve aArrayOfShapes(1 To UBound(aArrayOfShapes) + 1)
Else
ReDim Preserve aArrayOfShapes(1 To 1)
End If
Set aArrayOfShapes(UBound(aArrayOfShapes)) = oSh
End If
Next
'This section creates a random index number within the bounds of the
'length of aArrayOfShapes and assigns the shape with that index number
'to the Shape object ShapeX
Randomize
NumberX = Int((UBound(aArrayOfShapes) - (LBound(aArrayOfShapes) - 1)) * Rnd) + LBound(aArrayOfShapes)
Set ShapeX = aArrayOfShapes(NumberX)
'This section shuffles aArrayOfShapes
For N = LBound(aArrayOfShapes) To UBound(aArrayOfShapes)
J = CLng(((UBound(aArrayOfShapes) - N) * Rnd) + N)
If N <> J Then
Set Temp = aArrayOfShapes(N)
Set aArrayOfShapes(N) = aArrayOfShapes(J)
Set aArrayOfShapes(J) = Temp
End If
Next N
'This section loops through all Shapes in aArrayOfShapes and
'fades them out one by one EXCEPT for ShapeX
For Each Shape In aArrayOfShapes
If ShapeX.Name <> Shape.Name Then
Set FadeEffect = oSl.TimeLine.MainSequence.AddEffect _
(Shape:=Shape, effectid:=msoAnimEffectFade, trigger:=msoAnimTriggerAfterPrevious)
With FadeEffect
.Timing.Duration = 0.5
.Exit = msoTrue
End With
End If
Next Shape
End Sub
I had similar problem.
Try to replace:
ActiveWindow.View.Slide.SlideNumber
with:
ActivePresentation.SlideShowWindow.View.Slide.SlideIndex
It was what I needed in my project, maybe it helps you.