Format multiple selected shapes

[bjprengel]

Hi all,

First timer here, currently I am learning VBA and I am progressing pretty good if I say so myself (with Google of course:P).

I want to do the following: I want to be able to select multiple shapes and by clicking a button I want to be able to format the selected shapes. I am currently able to do this with one shape selected (see code) but when I select multiple shapes I get my error msgBox.

The Code:
Sub ActiveShape_10()

'PURPOSE: Determine the currently selected shape
Dim ActiveShape As Shape
Dim UserSelection As Variant

'Pull-in what is selected on screen
Set UserSelection = ActiveWindow.Selection

'Determine if selection is a shape I think I have to change something here... but I have no clue what
On Error GoTo NoShapeSelected
Set ActiveShape = ActiveSheet.Shapes(UserSelection.Name)
On Error Resume Next

'Do Something with your Shape variable
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With

Exit Sub

'Error Handler
NoShapeSelected:
MsgBox "You do not have a shape selected!"

End Sub

Heard there is a lot of expertise here so I hope you guys can help me out !!

Thanks in advance,

Grt.

 

[Domenic]

Try...

[color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] ActiveShape_10()

    [color=green]'PURPOSE: Determine the currently selected shape[/color]
    [color=darkblue]Dim[/color] oShapeRange [color=darkblue]As[/color] ShapeRange
    [color=darkblue]Dim[/color] UserSelection [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] NoShapeSelected
    
    [color=green]'Pull-in what is selected on screen[/color]
    [color=darkblue]Set[/color] UserSelection = ActiveWindow.Selection
    
    [color=green]'Determine if selection is a ShapeRange[/color]
    [color=darkblue]Set[/color] oShapeRange = UserSelection.ShapeRange
    
    [color=green]'Do Something with ShapeRange[/color]
    [color=darkblue]With[/color] Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]With[/color] Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    [color=darkblue]End[/color] With
    
    [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    
    [color=green]'Error Handler[/color]
NoShapeSelected:
    MsgBox "You do not have a shape selected!"

[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Hope this helps!

 

[bjprengel]

Sweet thanks Domenic !!!