VBA - Identifying Image Selected

SerenityNetworks

Board Regular
Joined
Aug 13, 2009
Messages
131
Office Version
  1. 365
Platform
  1. Windows
I'll use a macro to display several images in a worksheet. Then I'll enter some data in worksheet cells. After that I'll trigger another macro to delete the current images and then trigger the first macro to display a new set of images. All of this works fine.

What I'd like to do now is click on an image and be able to identify the image that was clicked. I'm not a coder, so I'm at a loss how to accomplish this task.

When I use the record macro feature, I record code like the following when I click on an image.
Code:
ActiveSheet.Shapes.Range(Array("Picture 39045")).Select
How can I click on an image and store the image selected as a variable (so I can manipulate the image in other procedures)?

Thanks in advance,
Andrew
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Like this


Code:
Sub ManipulateImage()
    Dim shp As Shape
    Set shp = GetShape
    
    If Not shp Is Nothing Then
        MsgBox "Height = " & shp.Height & vbCr & "Width = " & shp.Width, vbOKOnly, shp.Name
        If MsgBox("DELETE" & vbTab & GetShape.Name, vbYesNo, "Are you sure ?") = vbYes Then GetShape.Delete
    End If
End Sub

Function GetShape() As Shape
    If TypeName(Selection) = "Picture" Then Set GetShape = Application.Selection.ShapeRange.Item(1)
End Function
 
Upvote 0
Thank you Yongle! This is great and totally workable.

I've since tried to do similar and triggering the event by simply clicking on one of the pictures. That is, something similar to the following, but triggered when a picture is clicked upon.
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = Range("A5").Address Then
       MsgBox "A5 was selected"
    End If
End Sub
I've done some prowling of the internet, but not found any method for determining if a picture is selected. Is this possible? So far, I can only see how to use "SelectionChange" with cells.

If it's possible, I'd love to learn how. If it's not possible then your solution will work just fine for what I need.

Thank you again,
Andrew
 
Upvote 0
Put the code in the ThisWorkbook Module:
Code:
Option Explicit

Private WithEvents cmbrs As CommandBars

Private Sub Workbook_Activate()
    Set cmbrs = Application.CommandBars
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set cmbrs = Application.CommandBars
End Sub

Private Sub cmbrs_OnUpdate()
    Call ManipulateImage
End Sub

Private Sub ManipulateImage()
    Dim shp As Shape
    Set shp = GetShape
    
    If Not shp Is Nothing Then
        MsgBox "Height = " & shp.Height & vbCr & "Width = " & shp.Width, vbOKOnly, shp.Name
        If MsgBox("DELETE" & vbTab & GetShape.Name, vbYesNo, "Are you sure ?") = vbYes Then GetShape.Delete
    End If
End Sub

Private Function GetShape() As Shape
    If TypeName(Selection) = "Picture" Then Set GetShape = Application.Selection.ShapeRange.Item(1)
End Function
 
Upvote 0
@Jaafar Tribak
@
Yongle

Thank you Jaafar and thank you too Yongle. With these two routines I have ultimate flexibility.

With the latest routine, the "WithEvents cmbrs As CommandBars" was initially returning "Compile error: Invalid attribute in Sub or Function". But after I moved the "Private Sub Workbook_Open()" routine I am using below your "WithEvents" routine, it all worked perfectly.

Now I just need to substitute in my commands and I'm good.

Thank you again,
Andrew
 
Upvote 0
Okay. I'm stumped again.

I've successfully implemented the code that moves the picture clicked upon to a defined location and resizes it.

But the user may want to click on the picture again to move it, manually resize it, delete it, etc. (They may or may not activate other cells before clicking on the picture again.) So I'm trying to capture if the picture clicked on is the same picture that was last clicked on. If it is then I want to exit the macro (so the user can move it, resize it, delete it, etc.).

I can set the variable prevName the same as GetShape.Name, but not the variable shpName. I receive a run-time error '91' (see below). I can't figure out how to get around this problem. Any help would be appreciated.

Thanks again,
Andrew

Code:
Private Sub ManipulateImage()
    Dim shp As shape
    Dim shpName As Variant
    Dim prevName As Variant
    Dim wActiveCell As String
    Set shp = GetShape
    Set shpName = GetShape.Name ' THIS RETURNS: "Run-time error '91': Object variable or With block variable not set"
    If Not shp Is Nothing Then
        If prevName = "" Then
            prevName = GetShape.Name
            GoTo ResumeProcess
        End If
        If shpName = prevName Then
            Exit Sub
        End If
ResumeProcess:
        wActiveCell = ActiveCell.Address
        Selection.ShapeRange.ZOrder msoBringToFront
        shp.Width = Sheets("Parameters").Cells(27, 2).Value
        shp.Top = Sheets("Parameters").Cells(5, 2).Value
        shp.Left = Sheets("Parameters").Cells(6, 2).Value
        Range(wActiveCell).Select
        'MsgBox "Height = " & shp.Height & vbCr & "Width = " & shp.Width, vbOKOnly, shp.Name
        'If MsgBox("DELETE" & vbTab & GetShape.Name, vbYesNo, "Are you sure ?") = vbYes Then GetShape.delete
    End If
End Sub
 
Upvote 0
Try this :
Code:
Option Explicit

Private WithEvents cmbrs As CommandBars


Private Sub Workbook_Activate()
    Set cmbrs = Application.CommandBars
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set cmbrs = Application.CommandBars
End Sub

Private Sub cmbrs_OnUpdate()
    Call ManipulateImage
End Sub


Private Sub ManipulateImage()

    Dim shp As Shape
    
    Set shp = GetShape
    If Not shp Is Nothing Then
        MsgBox "Height = " & shp.Height & vbCr & "Width = " & shp.Width, vbOKOnly, shp.Name
        If MsgBox("DELETE" & vbTab & shp.Name, vbYesNo, "Are you sure ?") = vbYes Then shp.Delete
    End If

End Sub


Private Function GetShape() As Shape

    Static oPreviousShp As Shape
    Dim oCurrentShp As Shape
    
    If TypeName(Selection) = "Picture" Then
        Set oCurrentShp = Application.Selection.ShapeRange.Item(1)
        If oPreviousShp Is oCurrentShp Then
            Set GetShape = Nothing
        Else
            Set oPreviousShp = oCurrentShp
            Set GetShape = oCurrentShp
        End If
    Else
        Set oPreviousShp = Nothing
    End If
    
End Function
 
Last edited:
Upvote 0
@Jaafar Tribak

Thank you! That did it.

I had to remove the last Else statement.
Code:
Else
  Set oPreviousShp = Nothing
Something (the watcher?) was triggering it repeatedly, so it was always setting oPreviousShp to nothing and when I'd click on the same image it would act as though I'd never clicked on it before. After removing the last Else statement, it worked perfectly.

Thank you so very much. I both learned a little more about coding and my tool will be much more convenient for the user.

Regards,
Andrew
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top