LoadPicture Controls Challenge

[kelly mort]

Hello All,
I need help to figure out what I am doing wrongly here:
I wanna load image control on my worksheet with this script but I think i am doing something wrongly since I can't get the result.

Sub ShowPic ()
Dim fPath As String,  sFile As String
On Error resume next 
fPath = ThisWorkbook.Path & "\" & Me.CmbTerm.Text 
sFile = Dir (fPath & "/" & Right (Sheet2.Range("H9").Text, 3) & ".*")
If sFile  <> vbNullString Then 
Sheet2.Image1.Picture = LoadPicture(fPath & "\" & sFile )
Else
         Sheet2.Image1.Picture = LoadPicture ("")
End If 
If Err 53 Then
       Sheet2.Image1.Picture = LoadPicture ("")
End If 
On Error GoTo 0
End Sub

This line worked but I want to get it work with the worksheet:

i = Me.lstView.ListIndex 

sFile = Dir (fPath & "/" & Right (Me.lstView.Column(4 , i).Text, 3) & ".*")

I want to load the image each time I change the value in the cell H9 on the Sheet2. I wish this is possible.

Thanks
Kelly

 

[Worf]

Hello

This worked for me:

' sheet2 module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim fPath As String, sFile$
If Target = Me.[h9] Then
    fPath = ThisWorkbook.Path & "\" & Me.CmbTerm.Text
    sFile = Dir(fPath & "\" & Right(Me.[h9].Text, 3) & ".*")
    If sFile <> vbNullString Then
      Me.Image1.Picture = LoadPicture(fPath & "\" & sFile)
    Else
        Me.Image1.Picture = LoadPicture("")
    End If
    If Err.Number = 53 Then Me.Image1.Picture = LoadPicture("")
End If
End Sub

 

[kelly mort]

Hello

This worked for me:

' sheet2 module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim fPath As String, sFile$
If Target = Me.[h9] Then
    fPath = ThisWorkbook.Path & "\" & Me.CmbTerm.Text
    sFile = Dir(fPath & "\" & Right(Me.[h9].Text, 3) & ".*")
    If sFile <> vbNullString Then
      Me.Image1.Picture = LoadPicture(fPath & "\" & sFile)
    Else
        Me.Image1.Picture = LoadPicture("")
    End If
    If Err.Number = 53 Then Me.Image1.Picture = LoadPicture("")
End If
End Sub

Thanks very much for your time to get this working for me.

Wow I really appreciate it.

I have one more issue :
I have two controls on the sheet. How to get them working side by side has become a headache also. I am now understanding the script so if you won't mind, then show me how to get it working too.

It is pointing to H36 to load it. And named Image2

Thanks again
Kelly

 

[Worf]

Something like the code below. Is CmbTerm a combo box? How many of them do you have?

' sheet2 module
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Me.[h9] Or Target = Me.[h36] Then
    Select Case Target.Address
        Case Is = "$H$9"
            LoadIm "Image1", Me.[h9]
        Case Is = "$H$36"
            LoadIm "Image2", Me.[h36]
    End Select
End If
End Sub
Sub LoadIm(cname$, r As Range)
Dim fpath$, sfile$
fpath = ThisWorkbook.Path & "\" & Me.CmbTerm.Text       ' same CmbTerm control for both images
sfile = Dir(fpath & "\" & Right(r.Text, 3) & ".*")
If sfile <> vbNullString Then
    Me.OLEObjects(cname).Object.Picture = LoadPicture(fpath & "\" & sfile)
Else
    Me.OLEObjects(cname).Object.Picture = LoadPicture("")
End If
If Err.Number = 53 Then Me.OLEObjects(cname).Object.Picture = LoadPicture("")
End Sub

 

[kelly mort]

Something like the code below. Is CmbTerm a combo box? How many of them do you have?

' sheet2 module
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Me.[h9] Or Target = Me.[h36] Then
    Select Case Target.Address
        Case Is = "$H$9"
            LoadIm "Image1", Me.[h9]
        Case Is = "$H$36"
            LoadIm "Image2", Me.[h36]
    End Select
End If
End Sub
Sub LoadIm(cname$, r As Range)
Dim fpath$, sfile$
fpath = ThisWorkbook.Path & "\" & Me.CmbTerm.Text       ' same CmbTerm control for both images
sfile = Dir(fpath & "\" & Right(r.Text, 3) & ".*")
If sfile <> vbNullString Then
    Me.OLEObjects(cname).Object.Picture = LoadPicture(fpath & "\" & sfile)
Else
    Me.OLEObjects(cname).Object.Picture = LoadPicture("")
End If
If Err.Number = 53 Then Me.OLEObjects(cname).Object.Picture = LoadPicture("")
End Sub

OH nice. Thanks again.

Now to your question :

Yes the CmbTerm is a combobox on the userform.

So since I might have issues accessing it from the sheet i have a asigned its value to a cell on the sheet then use it in place of the CmbTerm

Thanks again
Kelly

 

[kelly mort]

Can you please explain the new script for me?

I wanna understand it better
Thanks
Kelly

 

[Worf]

I inserted some comments:

' sheet2 module
Private Sub Worksheet_Change(ByVal Target As Range) ' sheet event
If Target = Me.[h9] Or Target = Me.[h36] Then       ' one of the two cells changed
    Select Case Target.Address                      ' what cell
        Case Is = "$H$9"                            ' cell address
            LoadIm "Image1", Me.[h9]                ' call LoadIm for image 1
        Case Is = "$H$36"                           ' the other cell address
            LoadIm "Image2", Me.[h36]               ' call LoadIm for image 2
    End Select
End If
End Sub
Sub LoadIm(cname$, r As Range)                      ' arguments are string and range
Dim fpath$, sfile$
fpath = ThisWorkbook.Path & "\" & Me.CmbTerm.Text   ' same CmbTerm control for both images
sfile = Dir(fpath & "\" & Right(r.Text, 3) & ".*")  ' image name
If sfile <> vbNullString Then                       ' image was found
    ' load picture for desired control
    Me.OLEObjects(cname).Object.Picture = LoadPicture(fpath & "\" & sfile)
Else
    ' clear control picture
    Me.OLEObjects(cname).Object.Picture = LoadPicture("")
End If
End Sub

 

[kelly mort]

I inserted some comments:

' sheet2 module
Private Sub Worksheet_Change(ByVal Target As Range) ' sheet event
If Target = Me.[h9] Or Target = Me.[h36] Then       ' one of the two cells changed
    Select Case Target.Address                      ' what cell
        Case Is = "$H$9"                            ' cell address
            LoadIm "Image1", Me.[h9]                ' call LoadIm for image 1
        Case Is = "$H$36"                           ' the other cell address
            LoadIm "Image2", Me.[h36]               ' call LoadIm for image 2
    End Select
End If
End Sub
Sub LoadIm(cname$, r As Range)                      ' arguments are string and range
Dim fpath$, sfile$
fpath = ThisWorkbook.Path & "\" & Me.CmbTerm.Text   ' same CmbTerm control for both images
sfile = Dir(fpath & "\" & Right(r.Text, 3) & ".*")  ' image name
If sfile <> vbNullString Then                       ' image was found
    ' load picture for desired control
    Me.OLEObjects(cname).Object.Picture = LoadPicture(fpath & "\" & sfile)
Else
    ' clear control picture
    Me.OLEObjects(cname).Object.Picture = LoadPicture("")
End If
End Sub

Hi and sorry to wake this post again . But is there a way to use a cell that contains a formula instead of the direct changing from the cell?

Thanks
Kelly

 

[Worf]

• This example assumes formulas at H9 and H36.

• Note the directions on where to paste the code.

'****************************************

' ThisWorkbook module
Private Sub Workbook_Open()
    val1 = Sheets("sheet3").[h9]
    val2 = Sheets("sheet3").[h36]
End Sub
'****************************************
'******************************

' regular module
Public val1, val2

'******************************
'*************************************

' sheet module
Sub LoadIm(cname$, r As Range)                      ' arguments are string and range
Dim fpath$, sfile$
fpath = ThisWorkbook.Path & "\" & Me.CmbTerm.Text   ' same CmbTerm control for both images
sfile = Dir(fpath & "\" & Right(r.Text, 3) & ".*")  ' image name
If sfile <> vbNullString Then                       ' image was found
    ' load picture for desired control
    Me.OLEObjects(cname).Object.Picture = LoadPicture(fpath & "\" & sfile)
Else
    ' clear control picture
    Me.OLEObjects(cname).Object.Picture = LoadPicture("")
End If
End Sub

Private Sub Worksheet_Calculate()
If [h9] <> val1 Then
    val1 = [h9]
    LoadIm "Image1", Me.[h9]
End If
If [h36] <> val2 Then
    val2 = [h36]
    LoadIm "Image2", Me.[h36]
End If
End Sub
'**************************************

 

[kelly mort]

Thanks