How to specify where to insert the Alt Text of an image.

[tharnden7]

Is there a way to click on an image in one worksheet and have it insert the Alt Text in another worksheet? Ideally, I would like to select which cell to insert the Alt Text. For example, I have a worksheet filled with images that each have their own Alt Text. I would like to click on any image and be able to choose where I would like the Alt Text to be placed on a different worksheet. Is this possible?

 

[John_w]

Try this code, which is based largely on this brilliant code by @Jaafar Tribak.

VBA - Identifying Image Selected

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...

www.mrexcel.com

Put all this code in the ThisWorkbook module, then save, close and reopen the workbook.

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
    Dim AltTextCell As Range
    
    Set shp = GetShape
    If Not shp Is Nothing Then
        On Error Resume Next
        Set AltTextCell = Application.InputBox("Alt Text = " & shp.AlternativeText & vbLf & vbLf & "Select destination sheet and cell", Title:=shp.Name, Type:=8)
        On Error GoTo 0
        If Not AltTextCell Is Nothing Then
            AltTextCell.Range("A1").Value = shp.AlternativeText
        End If
    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
    End If
    
End Function