VBA change Picture 1

[theta]

Hi

I have an image on my workbook (tab called 'Section 1'). The image was just pasted into the workbook.

I need to make it so that when I change the selection of a data validation dropdown (client 1, client 2, client 3)...the image will change.

The logos are stored in the same dir of the workbook, in a sub-folder called 'Images'

So when 'client 1' is selected, named range of 'Selection' becomes 'client 1' and the VBA changes the picture to .\Images\client 1.bmp

Any ideas, better suggestions, examples?

 

[theta]

Unless I need to adopt this kind of approach :

Worksheets(”Section 1″).OLEObjects(”ILOGO″).Object.Picture _
= LoadPicture(FileToOpen)

?

 

[Andrew Poulsom]

You need to activate the worksheet before you can select a cell on it.

 

[theta]

Ok. So I will need to state Sheets("Section 1").Activate, then do the selection?

The following now works and places the logo on Section 1, but does not place in LogoSpace cell. I will try the activate method

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> Range("SelectedClient").Address Then Exit Sub
    
    Dim Pic As Picture
    On Error Resume Next
    
    Sheets("Section 1").Pictures("LOGO").Delete
    On Error GoTo 0
'    Target.Offset(, 2).Select
    Set Pic = Sheets("Section 1").Pictures.Insert(Me.Parent.Path & "\IMAGES\" & Target.Value & ".bmp")
    Pic.Name = "LOGO"
End Sub

 

[theta]

This object or method is not supported :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> Range("SelectedClient").Address Then Exit Sub

Dim Pic As Picture
On Error Resume Next

Sheets("Section 1").Pictures("LOGO").Delete
On Error GoTo 0
' Target.Offset(, 2).Select
Sheets("Section 1").Activate
Sheets("Section 1").Range("LogoSpace").Select
Set Pic = Sheets("Section 1").Range("LogoSpace").Pictures.Insert(Me.Parent.Path & "\IMAGES\" & Target.Value & ".bmp")
Pic.Name = "LOGO"
End Sub

 

[Andrew Poulsom]

Try:

rivate Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> Range("Clients").Address Then Exit Sub
    Dim Pic As Picture
    On Error Resume Next
    Sheets("Section 1").Pictures("LOGO").Delete
    On Error GoTo 0
    With Sheets("Section 1")
        Set Pic = .Pictures.Insert(Me.Parent.Path & "\Images\" & Target.Value & ".bmp")
        Pic.Name = "LOGO"
        With .Range("LogoSpace")
            Pic.Left = .Left
            Pic.Top = .Top
        End With
    End With
End Sub

 

[theta]

Andrew you are a star, great thanks!

Could I put a qualifier in so that if "Clients" does not exist then Exit Sub. Otherwise get Range error. What is the most efficient way to check if a range/named range exists? Or could I move on of the error handlers?

Think this build of 2007 is acting strange, even when i use the following simple macro, it dumps the image in a random place (not in the selected cell as others have reported)

Sub InsertPic()
Sheets("Section 1").Range("LogoSpace").Select
ActiveSheet.Pictures.Insert(ActiveSheet.Parent.Path & "\IMAGES\" & Sheets("INDEX").Range("SelectedClient").Value & ".bmp").Select
End Sub

 

[theta]

Also handle so that if the user deletes the cell contents, the sub exits i.e. SelectedClient is Nothing?

Using this as a learning exercise to find the most efficient ways of error handling etc

 

[Andrew Poulsom]

Also handle so that if the user deletes the cell contents, the sub exits i.e. SelectedClient is Nothing?

Using this as a learning exercise to find the most efficient ways of error handling etc

Try changing the first line to:

If Target.Address <> Range("Clients").Address Or Len(Target.Value) = 0 Then Exit Sub

 

[theta]

Thanks Andrew. I settled on this, let me know if all looks ok :

Private Sub Worksheet_Change(ByVal Target As Range)
    
    'If Target.Address <> Range("SelectedClient").Address Then Exit Sub
    If Target.Address <> Range("SelectedClient").Address Or Len(Target.Value) = 0 Then Exit Sub
    
    Dim Pic As Picture
    Dim ImageToLoad As String
    
    On Error Resume Next
    
    Sheets("Section 1").Pictures("LOGO").Delete
    On Error GoTo 0
    
    ImageToLoad = Me.Parent.Path & "\Images\" & Target.Value & ".bmp"
    
    If Not Len(Dir(ImageToLoad)) > 0 Then
        MsgBox "There is no LOGO.bmp for this client"
        Exit Sub
        Else
    End If
    
    With Sheets("Section 1")
        Set Pic = .Pictures.Insert(ImageToLoad)
        Pic.Name = "LOGO"
        With .Range("LogoSpace")
            Pic.Left = .Left
            Pic.Top = .Top
        End With
        
    End With
    
End Sub

Many thanks again, sure I will be using this alot!

 

[Andrew Poulsom]

That looks fine.