Images

[BullseyeThor]

Is there a way of assigning an image to text so when you enter for isntance sun, a picture of the saved imaged appears in a chosen cell?

Can this be done with multiple images as well?

Thanks

 

[Gary McMaster]

A little short on information as to exactly what you want to do.

Below is one way that assumes that the "key words" are predefined and not too numerous.

You could also have it search a directory or directories and attempt to find a file that matches any random word you keyed in instead of using a predefined list as in this example.

Maybe it uses a list of keywords and associated image files on a hidden sheet?

There would be lots of questions depending on how it is to work:

Are image file types all the same?
Are image files all in the same folder?
How many files?
How many sheets?
Do all sheets respond to the "key words"?
etc. etc.

Hope this helps.

Gary

Requires two image files "C:\Temp\sun.jpg & C:\Temp\moon.jpg in the said folder
Paste code in the "Workbook_SheetChange" event

Then type "Sun" or "Moon" (no quotes) in any cell.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim sPath As String
Dim oSheet As Worksheet
Dim oShape As Shape

'Requires two image files "C:\Temp\sun.jpg & C:\Temp\moon.jpg

sPath = "C:\Temp\" ' Change path to suit

Application.EnableEvents = False
    
    Select Case UCase(Target.Text)
        
        Case "SUN"
            Set oShape = Sh.Shapes.AddPicture(sPath & "sun.jpg", msoFalse, msoTrue, Target.Left, Target.Top, 1, 1)
            
        Case "MOON"
            Set oShape = Sh.Shapes.AddPicture(sPath & "moon.jpg", msoFalse, msoTrue, Target.Left, Target.Top, 1, 1)
            
        'Case ... as many case statements as needed associated to existing image files
            
        Case Else

    End Select
    
    If Not oShape Is Nothing Then
        oShape.ScaleHeight 1, msoTrue
        oShape.ScaleWidth 1, msoTrue
    End If

Application.EnableEvents = True

End Sub

 

[BullseyeThor]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sPath As String
Dim oSheet As Worksheet
Dim oShape As Shape
'Requires two image files "C:\Temp\sun.jpg & C:\Temp\moon.jpg
sPath = "S:\Design & Merchandising\Team Files\Mick's Folder\My Work" ' Change path to suit

Application.EnableEvents = True

Select Case UCase(Target.Text)

Case "TOPPS"
Set oShape = Sh.Shapes.AddPicture(sPath & "Topps.jpg", msoFalse, msoTrue, Target.Left, Target.Top, 1, 1)

Case "TCH"
Set oShape = Sh.Shapes.AddPicture(sPath & "TCH.jpg", msoFalse, msoTrue, Target.Left, Target.Top, 1, 1)

'Case ... as many case statements as needed associated to existing image files

Case Else
End Select

If Not oShape Is Nothing Then
oShape.ScaleHeight 1, msoTrue
oShape.ScaleWidth 1, msoTrue
End If

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub

I have changed some parts that I know but it hasn't worked can you see where I am going wrong.

Both images are in the same folder and and I only want to use one word to make it show the image in the cell.

Hope this is a bit more helpful

 

[Gary McMaster]

A couple of minor things:

Assuming you pasted the code in correct place in "ThisWorkbook" ...

You omitted the trailing back slash from "sPath" (highlighted in red). Therefore, it can't find the file and that is causing it to fail.

If you have more than a handful of images "Select Case" may not be the best way to do this. I don't think there is a limit to how many Select Case statements you can have but I believe there is a 64K limit for the amount of code in a module. Even if you don't exceed the 64K limit, using hundreds of Select Case statements would also be difficult to maintain if images / paths / keywords / whatever might change.

I notice you modified the "Application.EnableEvents" statements. Inserting an image does not cause the "Workbook_Sheetchange" event to fire so that is not causing any problems at the moment. However, if you were to further modify this code with something that does cause this event to fire like removing the keyword from the target cell just before or after you insert the image, serious problems can result. The event can/will call itself recursively. Depending on what it's doing it can enter an endless loop and run out of memory or stack space. I would be inclined to leave them in place. If the code stops working you can just paste "Application.EnableEvents = True" (no quotes) into the immediate (debug) window in the VBA IDE and press enter to turn the events back on. You could also create another procedure that contains just the single statement "Application.EnableEvents = True".

Gary

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim sPath As String
Dim oSheet As Worksheet
Dim oShape As Shape

'Requires two image files "C:\Temp\sun.jpg & C:\Temp\moon.jpg
sPath = "S:\Design & Merchandising\Team Files\Mick's Folder\My Work[COLOR=Red]\[/COLOR]" ' Change path to suit

[COLOR=Red]Application.EnableEvents = False[/COLOR]

Select Case UCase(Target.Text)

    Case "TOPPS"
    Set oShape = Sh.Shapes.AddPicture(sPath & "Topps.jpg", msoFalse, msoTrue, Target.Left, Target.Top, 1, 1)
    
    Case "TCH"
    Set oShape = Sh.Shapes.AddPicture(sPath & "TCH.jpg", msoFalse, msoTrue, Target.Left, Target.Top, 1, 1)
    
    'Case ... as many case statements as needed associated to existing image files
    
    Case Else
    
End Select

If Not oShape Is Nothing Then
    oShape.ScaleHeight 1, msoTrue
    oShape.ScaleWidth 1, msoTrue
End If

[COLOR=Red]Application.EnableEvents = True[/COLOR]

End Sub