excelvbauserform

Inserting images in userform and change "Teardrop 16" by clicking on rows


I want to write a user-form by Excel VBA. In my from, I have two forms: add and search.

In the add form I want to add name, IDs, section,... and images.

I can insert an image in the user-form and in "l" you can see the file path.

I also assign the image-paths to "l1", when I click on the path in the top of my table my path as shown.

I want to change the picture in "Teardrop16", when I click on a row.

enter image description here

This is the sub for assigning each row of my table to a cell:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheet1.Range("A1").Value = Cells(Target.Row, 3).Value
'Sheet1.Range("B1").Value = Cells(Target.Row, 9).Value
Sheet1.Range("C1").Value = Cells(Target.Row, 4).Value
Sheet1.Range("I1").Value = Cells(Target.Row, 9).Value
'ow for the changing the image :

Dim perRange As String
perRange = ActiveCell.Address
Application.ScreenUpdating = False

If ActiveSheet.Range("l1" & ActiveCell.Row).Value = "" Then
err:
    ActiveSheet.Shapes.Range(Array("Teardrop 16")).Select
    With Selection.ShapeRange.Fill
        .UserPicture "C:\Users\niloofar sabouri\OneDrive\Desktop\pic\null.jpg"
        Range(perRange).Select
    End With
Exit Sub
End If

Dim iRow As Long
iRow = Sheet1.Cells(Rows.Count, "E").End(xlUp).Row
If Not Intersect(Target, Range("C4:" & "l1" & iRow)) Is Nothing Then

    ActiveSheet.Shapes.Range(Array("Teardrop 16")).Select
    With Selection.ShapeRange.Fill
        On Error GoTo err
        .UserPicture ActiveSheet.Range("l1" & ActiveCell.Row)
        Range(perRange).Select
    End With
End If

End Sub

Solution

  • Option Explicit
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim iRow As Long, sValue, sPic As String
        iRow = Me.Cells(Me.Rows.Count, "E").End(xlUp).Row
        If Not Intersect(Target, Me.Range("C4:I" & iRow)) Is Nothing Then
            sPic = Me.Cells(Target.Row, "I").Value
            If Len(sPic) = 0 Then
                sPic = "C:\Users\niloofar sabouri\OneDrive\Desktop\pic\null.jpg"
            End If
            Me.Shapes("Teardrop 16").Fill.UserPicture sPic
        End If
    End Sub