LoadPicture Controls Challenge

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
2,169
Office Version
  1. 2016
Platform
  1. Windows
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.

Code:
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:

Code:
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
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Hello

This worked for me:

Code:
' 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
 
Upvote 0
Hello

This worked for me:

Code:
' 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
 
Upvote 0
Something like the code below. Is CmbTerm a combo box? How many of them do you have?


Code:
' 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
 
Upvote 0
Something like the code below. Is CmbTerm a combo box? How many of them do you have?


Code:
' 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
 
Upvote 0
Can you please explain the new script for me?

I wanna understand it better
Thanks
Kelly
 
Upvote 0
I inserted some comments:

Code:
' 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
 
Upvote 0
I inserted some comments:

Code:
' 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
 
Upvote 0
  • This example assumes formulas at H9 and H36.

  • Note the directions on where to paste the code.

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
'**************************************
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,587
Messages
6,120,406
Members
448,958
Latest member
Hat4Life

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