Load Image from path into Image ActiveX Control in worksheet

Microsoft 365 is a subscription version: you pay a monthly or yearly fee. The Office applications in Microsoft 365 are updated every month.

There is also a version you pay only once: Office 2024. This is currently up-to-date, but it won't get new features.

See this website

Thanks I have sent the workbook to your PM 

Or better still, I'll send the workbook to your PM so you would open it just to confirm if such error pops up.

Thanks

Okay, please what's the latest version please and how do I get it?

Or do you suggest I trying installing same office version of mine into these systems to see if the issue is resolved.

But I would like to know the latest version and how I can get it

I don't have these older versions; I am afraid I don't know what causes the problem.

Yes, 2016, 2019 but mine is 2021

Do those computers have a different version of Excel than you have?

Thanks.

I've finished everything, everything is working perfectly on my system, but when I sent it to another system, I got error message as attached in the pics.

I tried about 3 different systems and it's same thing but such error didn't occur when I open it with my system, please what's the cause and probable solution.

Thanks

Muhammadiyya 

The macro UpdateComboBox2 mistakenly referred to Sheet3 instead of Sheet4. It should be

Sub UpdateComboBox2()
    Dim combobox As Object
    Dim studentRange As Range

    ' Reference the ActiveX ComboBox
    Set combobox = Sheet15.ComboBox1

    ' Clear the ComboBox
    combobox.Clear

    ' Define the dynamic range of students in JSS2BD sheet
    On Error Resume Next
    Set studentRange = Sheet4.Range("JSS2STUDENTS")
    
    ' Add the students to the ComboBox
    If Not studentRange Is Nothing Then
        If studentRange.Count = 1 Then
            combobox.AddItem studentRange.Value
        Else
            combobox.List = studentRange.Value
        End If
    End If
End Sub

Muhammadiyya 

I'm busy right now, I'll look at it later today.

Muhammadiyya 

I have replied to your private message.

Thanks there's, no error again when it's empty but after clearing the BioData all the combobox in the report card sheets are not updating (no name reflects in the combobox after Students were added using the registration forms) how do I fix this issue. I'll forward a copy of the workbook to your PM if needed sir

thanks HansVogelaar 

Muhammadiyya 

The name JSS1STUDENTS refers to =OFFSET(JSS1BD!$B$1,1,0,COUNTIF(JSS1BD!$B$1:$B$996,"> ")-1,1)

If there are no students, COUNTIF(JSS1BD!$B$1:$B$996,"> ")-1 evaluates to 0, and this causes the error.

The easiest workaround is to use On Error Resume Next to suppress the error.

Sub UpdateComboBox()
    Dim combobox As Object
    Dim studentRange As Range

    ' Reference the ActiveX ComboBox
    Set combobox = Sheet1.ComboBox1

    ' Clear the ComboBox
    combobox.Clear

    ' Define the dynamic range of students in JSS1BD sheet
    On Error Resume Next ' THIS LINE IS NEW
    Set studentRange = Sheet3.Range("JSS1STUDENTS")

    ' Add the students to the ComboBox
    If Not studentRange Is Nothing Then
        combobox.List = studentRange.Value
    End If
End Sub

Muhammadiyya 

On the Formulas tab of the ribbon, click Name Manager.

Does the defined name SS1STUDENTS still exist, or has it disappeared?

If it exists: what does it refer to?

hi, I am done with the project, I tried to clear the JSS1BD, JSS2BD, JSS3BD, SS1BD, SS2BD, SS3BD in order the leave those sheets empty for entry by the user.

i did that manually and the update combobox macro for each of the sheets has bug as attached. Attached is a sample of SS1BD which I cleared and the updatecombobox bug.

How do I debug it to work perfectly even when the BioData sheets are empty so as not to create bug when the ResetToDefault macro (Macro to clear scores and BioData) is triggered thanksHansVogelaar 

Thanks so muc, it worked perfectly.

You're a genius@HansVogelaar 

Muhammadiyya 

Like this:

Sub LoadStudentImage()
    Dim wsBioData As Worksheet
    Dim wsReportCards As Worksheet
    Dim picturePath As String
    Dim studentName As String
    Dim studentRow As Range
    Dim studPicShape As Shape

    ' Set your worksheets
    Set wsBioData = ThisWorkbook.Sheets("JSS1BD")
    Set wsReportCards = ThisWorkbook.Sheets("JSS1RC")
    ' Remove the existing picture if it exists
    wsReportCards.Shapes("STUDPIC").Fill.Solid

    ' Get the student name from the linked cell (F2) of the ActiveX ComboBox
    studentName = wsReportCards.Range("F2").Value

    ' Find the student in the BioData sheet (Column B)
    Set studentRow = wsBioData.Columns("B").Find(What:=studentName, LookIn:=xlValues, LookAt:=xlWhole)

    If Not studentRow Is Nothing Then
        picturePath = wsBioData.Cells(studentRow.Row, "F").Value
        If Dir(picturePath) <> "" Then
            On Error Resume Next
            wsReportCards.Shapes("STUDPIC").Fill.UserPicture picturePath
            On Error GoTo 0
        Else
            MsgBox "Picture not found for student: " & studentName, vbExclamation
        End If
    Else
        MsgBox "Student not found in BioData sheet: " & studentName, vbExclamation
    End If
End Sub

thanks so much it worked as wanted but when there's no image path of the student selected, the last loaded image remains on the shape. I want it to be empty when there's no image path for the selected student.

thanks so much you're really the best I've crossed on this forumHansVogelaar 

Muhammadiyya 

Activate the JSS1RC sheet.

Activate the Developer tab of the ribbon.

Click to highlight the 'Design Mode' button.

Double-click the ActiveX combo box.

This will take you to the worksheet module in the Visual Basic Editor. You should see something like

Private Sub ComboBox1_Change()

End Sub

where ComboBox1 is the name of the combo box. Make the code look like this:

Private Sub ComboBox1_Change()
    Dim wsBioData As Worksheet
    Dim wsReportCards As Worksheet
    Dim picturePath As String
    Dim studentName As String
    Dim studentRow As Range

    ' Set your worksheets
    Set wsBioData = ThisWorkbook.Sheets("JSS1BD")
    Set wsReportCards = Me

    ' Get the student name from the linked cell (F2) of the ActiveX ComboBox
    studentName = wsReportCards.Range("F2").Value
    If studentName = "" Then Exit Sub

    ' Find the student in the BioData sheet (Column B)
    Set studentRow = wsBioData.Columns("B").Find(What:=studentName, LookIn:=xlValues, LookAt:=xlWhole)

    If Not studentRow Is Nothing Then
        picturePath = wsBioData.Cells(studentRow.Row, "F").Value
        If Dir(picturePath) <> "" Then
            ' Remove the existing picture if it exists
            On Error Resume Next
            wsReportCards.Shapes("STUDPIC").Fill.UserPicture picturePath
            On Error GoTo 0
        Else
            MsgBox "Picture not found for student: " & studentName, vbExclamation
        End If
    Else
        MsgBox "Student not found in BioData sheet: " & studentName, vbExclamation
    End If
End Sub

Please i want to load image of each students in active X combobox  into shape (STUDPIC) on sheet JSS1RC, here's the code I applied:

Sub LoadStudentImage()
Dim wsBioData As Worksheet
Dim wsReportCards As Worksheet
Dim picturePath As String
Dim pictureFound As Boolean
Dim studentName As String
Dim studentRow As Range
Dim extensions As Variant
Dim ext As Variant
Dim studPicShape As Shape

' Set your worksheets
Set wsBioData = ThisWorkbook.Sheets("JSS1BD")
Set wsReportCards = ThisWorkbook.Sheets("JSS1RC")

' Get the student name from the linked cell (F2) of the ActiveX ComboBox
studentName = wsReportCards.Range("F2").Value

' Find the student in the BioData sheet (Column B)
Set studentRow = wsBioData.Columns("B").Find(What:=studentName, LookIn:=xlValues, LookAt:=xlWhole)

If Not studentRow Is Nothing Then
' Initialize picture path and extensions
extensions = Array(".jpg", ".JPG", ".jpeg", ".JPEG", ".png", ".PNG", ".bmp", ".BMP")
pictureFound = False

' Loop through each extension to check if the image exists
For Each ext In extensions
picturePath = wsBioData.Cells(studentRow.Row, "F").Value

' Modify the path to account for the extension
If Dir(picturePath) <> "" Then
pictureFound = True
Exit For
End If
Next ext

' If picture found, insert it into the STUDPIC shape
If pictureFound Then
' Remove the existing picture if it exists
On Error Resume Next
wsReportCards.Shapes("STUDPIC").Fill.UserPicture (picturePath)
On Error GoTo 0
Else
MsgBox "Picture not found for student: " & studentName & vbCrLf & "Checked extensions: jpg, png, bmp", vbExclamation
End If
Else
MsgBox "Student not found in BioData sheet: " & studentName, vbExclamation
End If
End Sub

The code displayed only one pics and doesn't change as combobox selection changes.

Please how do I achieve this. Thanks so much for all the helps you've be rendering to meHansVogelaar 

Muhammadiyya 

It is caused by the line If n < 1 Or n > 20 Then Exit Sub. This skips the line to re-enable events.

Modified version:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim n As Integer
    Dim m As Integer
    Dim i As Integer
    Dim ws As Worksheet
    Dim nameValue As Variant
    Dim avgValue As Variant
    Dim matchRow As Variant

    If Intersect(Range("H5"), Target) Is Nothing Then Exit Sub

    ' Check if the worksheet is protected before clearing the range
    If Me.ProtectContents Then
        MsgBox "The sheet is protected. Please unprotect the sheet to clear the data.", vbExclamation
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set ws = ThisWorkbook.Sheets("JSS2SS")

    ' Clear previous position numbers, names, and averages
    Me.Range("D7:L26").ClearContents

    ' Get the selected value from the cell
    n = Range("H5").Value
    m = Application.CountIf(ws.Range("CP3:CP96"), ">0")
    If m < n Then n = m

    ' Ensure that n is within the valid range
    If n < 1 Or n > 20 Then GoTo ExitHere

    ' Loop through and fill in the numbers 1 to n
    For i = 1 To n
        ' Populate the position numbers in column D
        Me.Cells(i + 6, 4).Value = i

        On Error Resume Next
        ' Get the row number using MATCH function
        matchRow = Application.WorksheetFunction.Match(i, ws.Range("CQ3:CQ999"), 0)
        On Error GoTo 0

        If IsError(matchRow) Then
            ' If matchRow is an error, skip to the next iteration
            Me.Cells(i + 6, 5).Value = "-"
            Me.Cells(i + 6, 12).Value = "-"
        Else
            ' Get the student name using INDEX and MATCH
            nameValue = ws.Range("B3:B999").Cells(matchRow, 1).Value

            If IsEmpty(nameValue) Or nameValue = "" Then
                Me.Cells(i + 6, 5).Value = "-"
            Else
                Me.Cells(i + 6, 5).Value = nameValue
            End If

            ' Get the average using INDEX and MATCH
            avgValue = ws.Cells(matchRow + 2, 94).Value

            If IsEmpty(avgValue) Or avgValue = "" Then
                Me.Cells(i + 6, 12).Value = "-"
            Else
                Me.Cells(i + 6, 12).Value = avgValue
            End If
        End If
    Next i

    ' Hide rows where no data should be displayed
    For i = 1 To 20
        Me.Rows(i + 6).Hidden = (i > n)
    Next i

ExitHere:
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

HansVogelaar

Attached is the code used in JSS1TOP10 for index and match of data from JSS1SS.

copied and edited accordingly in other related sheets (JSS2TOP10, JSS3TOP10, SS1TOP10)

the code works perfectly but each time I clear the drop-down button (no value selected) in any of the sheet (e g JSS2TOP10), the code stops working when I reselect a value and this issue affects Even other sheets until I close and reopen the workbook again but if I clear the drop-down again, same issue comes up. What could be the cause and how do I adjust the code to tackle this?

Please I'm almost done with the project, help me resolve this.

ThanksHansVogelaar