VBA UserForm picture won't change after _Click() function executes

richh

richh

Board Regular
Joined
Jun 24, 2007
Messages
245
Office Version
  1. 365
  2. 2016
I have a userform that has an image element on it. Depending on what criteria the user selects, the picture changes. It also has a function that follows a hyperlink on click. However, the picture will not change after following the link.

Code: 
    'Portion of the main code that alters the image

    If log.Cells(CInt(row), 10).Hyperlinks.Count > 0 Then
        Me.wLink.Caption = log.Cells(CInt(row), 10).Hyperlinks(1).Address
    Else
        Me.wLink.Caption = ""
    End If
    
    Me.pic.Picture = LoadPicture(vbNullString) 'attempt to clear the picture before grabbing a new one
    If Dir(ThisWorkbook.path & "\itemPics", vbDirectory) <> "" Then 'check to see if directory exists
        If Dir(ThisWorkbook.path & "\itemPics\" & log.Cells(CInt(row), 2).Value & "_" & log.Cells(CInt(row), 3).Value & ".jpg") <> "" Then 'if directory exists, check to see if file is found
            path = ThisWorkbook.path & "\itemPics\" & log.Cells(CInt(row), 2).Value & "_" & log.Cells(CInt(row), 3).Value & ".jpg"
            Me.pic.Picture = LoadPicture(path)
            Me.pic.ControlTipText = "Follow link"
        Else
            Me.pic.ControlTipText = "Image not found"
        End If
    Else
        Me.pic.ControlTipText = "Image directory not found. This workbook must remain in the CATALOG folder to access the image files."
    End If

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

    'The private sub to follow a link
    'adapted from https://social.msdn.microsoft.com/Forums/en-US/42fbea0d-3977-480f-a4c3-6093e34f469d/open-a-web-page-with-vba?forum=isvvba
Private Sub pic_Click()
    Dim oLink  As String
    Dim IEapp As Object
    
    Set IEapp = CreateObject("InternetExplorer.Application") 'Set IEapp = InternetExplorer
    
    oLink = Me.wLink.Caption
    'oLink = "https://www.google.com"

    If oLink <> "" And InStr(oLink, "mailto") = 0 Then
        With IEapp
            .Silent = True 'No Pop-ups
            .Visible = True 'Set InternetExplorer to Visible
            .Navigate oLink 'Load web page

            Do While .Busy
                DoEvents
            Loop

            Do While .ReadyState <> 4
                DoEvents
            Loop
        
        End With
    End If
End Sub

As mentioned, the pictures change fine before clicking. Once clicked, the current image will remain and changing one's selection in the user form will not change the picture.

Any help would be appreciated!
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
Can you post your entire code? I see you have the complete click event code, but whatever event you're using to change the picture...post that if you can.

If you can't for some reason, it might help us to know what event you're using to change the image.
 
Upvote 0
Sure.

Code: 
'combo box selection determines list of other combo boxes
Private Sub pCat_click()
    Dim mCat, sCat  As String
    Dim log         As Worksheet
    Dim lRow        As Integer
    Dim j           As Integer
    
    Set log = ThisWorkbook.Worksheets("Catalog")
    lRow = log.Cells(Rows.Count, 1).End(xlUp).row
    
    
    Me.mCat.Clear
    Me.sCat.Clear
    
    For j = 13 To 34 'item info is from (row,2):(row,12). 13-34 lists the programs. Finds the program column associated with user selection
        If log.Cells(1, j).Value = Me.pCat.Value Then
            Call sortDB(j) 'simple sort on the program column
            For i = 2 To lRow
                If IsEmpty(log.Cells(i, j).Value) = False Then
                    If InStr(UCase(mCat), UCase(log.Cells(i, 11).Value)) = 0 Then
                        mCat = mCat & log.Cells(i, 11).Value & "|"
                        Me.mCat.addItem log.Cells(i, 11).Value
                    End If
                    If InStr(UCase(sCat), UCase(log.Cells(i, 12).Value)) = 0 Then
                        sCat = sCat & log.Cells(i, 12).Value & "|"
                        Me.sCat.addItem log.Cells(i, 12).Value
                    End If
                Else
                    Exit For ' as the list is sorted, once it reaches a blank row, it stops cycling
                End If
            Next i
            Exit For
        End If
    Next j
    
    Call ItemSearch
End Sub

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

'*** popluates listbox depending on criteria selected

Public Function ItemSearch()
    Dim cat         As Worksheet
    
    Dim catRow      As Integer
    Dim catCol      As Integer
    Dim catlRow     As Integer
    Dim lBox        As Integer
    
    
    Set cat = ThisWorkbook.Worksheets("Catalog")
    lBox = 0
    Me.results.Clear
    
    catlRow = cat.Cells(Rows.Count, 1).End(xlUp).row 'Catalog last row
    
    If Me.cOpt.Value = True Then 'the user wants to look for items based on categories. kinda janky; could use escape code but it works
        Dim catCrit     As Integer
        Dim aFlag       As Boolean
        catCrit = 0
        aFlag = False
        
        If Me.pCat.Value <> "" Then
            catCrit = catCrit + 1
            catCol = 13
            
            Do While cat.Cells(1, catCol).Value <> Me.pCat.Value
                catCol = catCol + 1
            Loop
        End If
        
        If Me.mCat.Value <> "" Then
            catCrit = catCrit + 2
        End If
        
        If Me.sCat.Value <> "" Then
            catCrit = catCrit + 4
        End If
        
        For catRow = 2 To catlRow
            Select Case catCrit
                Case 1 'only program was selected
                    If IsEmpty(cat.Cells(catRow, catCol).Value) = False Then
                    aFlag = True
                        GoTo addItem
                    End If
                Case 2 'only a main category was selected
                    If cat.Cells(catRow, 11).Value = Me.mCat.Value Then
                        aFlag = True
                        GoTo addItem
                    End If
                Case 3 'program + main cat selected
                    If IsEmpty(cat.Cells(catRow, catCol).Value) = False And _
                    cat.Cells(catRow, 11).Value = Me.mCat.Value Then
                        aFlag = True
                        GoTo addItem
                    End If
                Case 4 'only subcategory selected
                    If cat.Cells(catRow, 12).Value = Me.sCat.Value Then
                        aFlag = True
                        GoTo addItem
                    End If
                Case 5 'program + subCat
                    If IsEmpty(cat.Cells(catRow, catCol).Value) = False And _
                    cat.Cells(catRow, 12).Value = Me.sCat.Value Then
                        aFlag = True
                        GoTo addItem
                    End If
                Case 6 'mainCat + subCat
                    If cat.Cells(catRow, 11).Value = Me.mCat.Value And _
                    cat.Cells(catRow, 12).Value = Me.sCat.Value Then
                        aFlag = True
                        GoTo addItem
                    End If
                Case 7 'all selected
                    If IsEmpty(cat.Cells(catRow, catCol).Value) = False And _
                    cat.Cells(catRow, 11).Value = Me.mCat.Value And _
                    cat.Cells(catRow, 12).Value = Me.sCat.Value Then
                        aFlag = True
                        GoTo addItem
                    End If
                End Select
addItem:
                If aFlag = True Then
                    Me.results.addItem
                    Me.results.List(lBox, 0) = cat.Cells(catRow, 6).Value
                    Me.results.List(lBox, 1) = cat.Cells(catRow, 5).Value
                    Me.results.List(lBox, 2) = cat.Cells(catRow, 2).Value
                    Me.results.List(lBox, 3) = catRow
                    
                    lBox = lBox + 1
                    aFlag = False
                End If
        Next catRow
    ElseIf Me.kOpt.Value = True Then 'user is looking for an item based upon typed keyword
        For catRow = 2 To catlRow
            Dim keyW As String
            keyW = CStr(Me.keyword.Value)
            
            If InStr(UCase(cat.Cells(catRow, 1).Value), UCase(keyW)) > 0 Or _
            InStr(UCase(cat.Cells(catRow, 4).Value), UCase(keyW)) > 0 Or _
            InStr(UCase(cat.Cells(catRow, 5).Value), UCase(keyW)) > 0 Or _
            InStr(UCase(cat.Cells(catRow, 6).Value), UCase(keyW)) > 0 Or _
            InStr(UCase(cat.Cells(catRow, 11).Value), UCase(keyW)) > 0 Or _
            InStr(UCase(cat.Cells(catRow, 12).Value), UCase(keyW)) > 0 Then
                Me.results.addItem
                Me.results.List(lBox, 0) = cat.Cells(catRow, 6).Value
                Me.results.List(lBox, 1) = cat.Cells(catRow, 5).Value
                Me.results.List(lBox, 2) = cat.Cells(catRow, 2).Value
                Me.results.List(lBox, 3) = catRow
                    
                lBox = lBox + 1
            End If
        Next catRow
    End If
    
End Function

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

'***populates fields on user form depending on user selection

Private Sub results_Click()
    Dim log         As Worksheet
    Dim row         As String
    Dim path        As String
    
    Set log = ThisWorkbook.Worksheets("Catalog")
    
    With results
        row = .List(.ListIndex, 3) 'row number on the category sheet are stored in the listbox so i don't have to search for the item again
    End With
    
    'MsgBox row
    
    Me.iDesc.Caption = log.Cells(CInt(row), 4).Value
    Me.mainCat.Caption = log.Cells(CInt(row), 11).Value
    Me.subCat.Caption = log.Cells(CInt(row), 12).Value
    Me.MFGName.Caption = log.Cells(CInt(row), 1).Value
    Me.MFGNum.Caption = log.Cells(CInt(row), 2).Value
    Me.ePrice.Caption = "$" & log.Cells(CDec(row), 8).Value
    Me.UofM.Caption = log.Cells(CInt(row), 7).Value
    
    
    If log.Cells(CInt(row), 10).Hyperlinks.Count > 0 Then
        Me.wLink.Caption = log.Cells(CInt(row), 10).Hyperlinks(1).Address
    Else
        Me.wLink.Caption = ""
    End If
    
    Me.pic.Picture = LoadPicture(vbNullString)
    If Dir(ThisWorkbook.path & "\itemPics", vbDirectory) <> "" Then
        If Dir(ThisWorkbook.path & "\itemPics\" & log.Cells(CInt(row), 2).Value & "_" & log.Cells(CInt(row), 3).Value & ".jpg") <> "" Then
            path = ThisWorkbook.path & "\itemPics\" & log.Cells(CInt(row), 2).Value & "_" & log.Cells(CInt(row), 3).Value & ".jpg"
            Me.pic.Picture = LoadPicture(path)
            Me.pic.ControlTipText = "Follow link"
        Else
            Me.pic.ControlTipText = "Image not found"
        End If
    Else
        Me.pic.ControlTipText = "Image directory not found. This workbook must remain in the CATALOG folder to access the image files."
    End If
  
End Sub
 
Last edited:
Upvote 0
I found the solution - repaint.

end of the results_click code ends with...


Code: 
    'Portion of the main code that alters the image

    If log.Cells(CInt(row), 10).Hyperlinks.Count > 0 Then
        Me.wLink.Caption = log.Cells(CInt(row), 10).Hyperlinks(1).Address
    Else
        Me.wLink.Caption = ""
    End If
    
    Me.pic.Picture = LoadPicture(vbNullString) 'attempt to clear the picture before grabbing a new one
    If Dir(ThisWorkbook.path & "\itemPics", vbDirectory) <> "" Then 'check to see if directory exists
        If Dir(ThisWorkbook.path & "\itemPics\" & log.Cells(CInt(row), 2).Value & "_" & log.Cells(CInt(row), 3).Value & ".jpg") <> "" Then 'if directory exists, check to see if file is found
            path = ThisWorkbook.path & "\itemPics\" & log.Cells(CInt(row), 2).Value & "_" & log.Cells(CInt(row), 3).Value & ".jpg"
            Me.pic.Picture = LoadPicture(path)
            Me.pic.ControlTipText = "Follow link"
        Else
            Me.pic.ControlTipText = "Image not found"
        End If
    Else
        Me.pic.ControlTipText = "Image directory not found. This workbook must remain in the CATALOG folder to access the image files."
    End If

    Catalog.Repaint
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
Infinite loop slideshow
Replies
1
Views
222
Domenic
D
S
  • Question Question
VBA issue, future steps, break prior.
Replies
1
Views
766
Gokhan Aycan
Gokhan Aycan
H
  • Question Question
image hyperlink inserted from User form wont open
Replies
2
Views
889
hsolanki
H
H
  • Question Question
Add image from Userform to corresponding data entered on each row
Replies
1
Views
1K
Worf
Worf
H
  • Question Question
Image hyperlink wont open
Replies
0
Views
752
hsolanki
H

Forum statistics

Threads
1,224,819
Messages
6,181,153
Members
453,021
Latest member
Justyna P

Share this page

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