назначить макрос для изображения в Excel

Question

Я вставил изображение со следующими кодами. Затем я хочу сразу выбрать вновь вставленное изображение и назначить макрос для изображения и применить к нему некоторое форматирование. Мне нужна твоя помощь.

        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

Когда вы добавляете фигуру, она будет последней формой на листе, поэтому:

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

(Всякий раз, когда я помещаю фигуру на лист, я даю ей Name так что я могу обратиться к нему позже)

Answer 2

Если вы присваиваете переменную фигуре, то впоследствии легко ссылаться на нее

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)

Затем вы можете использовать форму, подобную этой

myShape.TypeHereYourProperty ...