将宏分配给 excel 中的图像

Question

I have inserted an image with the following codes. Next, I want to select the newly inserted image immediately and assign a macro to picture and apply some formatting with it. I need your help.

        Sub InsertPicUsingShapeAddPictureFunction()
        Dim profile As String
        On Error GoTo 0
        Dim fd As FileDialog

        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        With fd
            .Filters.Clear
            .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
            .ButtonName = "Select"
            .AllowMultiSelect = False
            .Title = "Choose Photo"
            .InitialView = msoFileDialogViewDetails
            .Show
        End With
        ActiveSheet.Range("B3").Select

        ActiveSheet.Shapes.AddPicture Filename:=fd.SelectedItems(1), _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoCTrue, _
        Left:=ActiveSheet.Range("B3").Left + 2, _
        Top:=ActiveSheet.Range("B3").Top + 2, _
        Width:=123, _
        Height:=134

'here I am trying to select the inserted picture but the error is displayed

ActiveSheet.Shapes(fd.SelectedItems(1)).select

With selection
.onaction = "CustomMacro"
.placement = 1

End with


    End Sub

Answer 1

If you assign a variable to the shape it is easy to reference it afterwards

Dim myShape as shape
set myShape = ActiveSheet.Shapes.AddPicture (Filename:=fd.SelectedItems(1), _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoCTrue, _
    Left:=ActiveSheet.Range("B3").Left + 2, _
    Top:=ActiveSheet.Range("B3").Top + 2, _
    Width:=123, _
    Height:=134)

You can then use the shape like this

myShape.TypeHereYourProperty ...

Answer 2

When you add a Shape, it will be the last Shape on the sheet, so:

Sub InsertPicUsingShapeAddPictureFunction()
        Dim profile As String, sh As Shape
        On Error GoTo 0
        Dim fd As FileDialog

        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        With fd
            .Filters.Clear
            .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
            .ButtonName = "Select"
            .AllowMultiSelect = False
            .Title = "Choose Photo"
            .InitialView = msoFileDialogViewDetails
            .Show
        End With
        ActiveSheet.Range("B3").Select

        ActiveSheet.Shapes.AddPicture Filename:=fd.SelectedItems(1), _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoCTrue, _
        Left:=ActiveSheet.Range("B3").Left + 2, _
        Top:=ActiveSheet.Range("B3").Top + 2, _
        Width:=123, _
        Height:=134

'here I am trying to select the inserted picture but the error is displayed


    Set sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    With sh
        .OnAction = "CustomMacro"
        .Placement = 1
    End With
End Sub

(Whenever I put a Shape on a sheet, I give it a Name so I can refer to it later)