jpeg for autoshape fill

[rickblunt]

Greetings,
I was just given a WB with 60 WS in it that has a hundreds of text boxes in it. My task is to insert a jpeg signature (a picture of the bosses signature) into each of these rectangles at the click of a button. Using the macro recorder I came up with the following macro. Not wanting to have a macro for each rectangle of course, (or reformat the entire WB to get rid of the shapes...) can anyone help me tweak the code for the "active shape"? That way the boss only has to select the box he wants his signature in, and then click the command button.

Thanks for your help,

Sub RickSignature()
'
' This macro uses a JPEG of a signature as the fill of an textbox.
'
'
    ActiveSheet.Shapes("Rectangle 137").Select
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 2#
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Fill.UserPicture _
        "C:\Documents and Settings\rblunt1\Desktop\Rick.jpg"
End Sub

 

[VoG]

Try

Sub RickSignature()
'
' This macro uses a JPEG of a signature as the fill of an textbox.
'
'
Dim s As String
On Error Resume Next
s = Selection.Name
On Error GoTo 0
If s = "" Or Not s Like "Rectangle*" Then
    MsgBox "Click on a rectangle first"
    Exit Sub
End If
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 2#
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Fill.UserPicture _
        "C:\Documents and Settings\rblunt1\Desktop\Rick.jpg"
End Sub

 

[rickblunt]

Sweet! Worked perfectly, and the message box sure was a nice touch! Thanks a bunch VoG, you have saved me again, sure appreciate it.