إضافة صور الموظفين

[سمير الليل]

السلام عليكم

المرجو المساعدة في إضافة صور الموظفين

الصور تكون خارج ملف اكسل و مرتبطة به

و شكرا

 

اعرض الملف

برنامج خاص بالموظفين

---

 

---

• صاحب الملف
  سمير الليل
• تمت الاضافه
  25 مار, 2024
• الاقسام
  قسم الإكسيل

 

[محمد هشام.]

جرب هذا  

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Patch As String, Img As Boolean, Strfile As String, Imgfile As String
If Not Intersect(Target, Range("k3")) Is Nothing Then
Dim rng As Range, Clé As String, Cpt As Long
Set WS = Feuil1: Set dest = Feuil2: Clé = dest.[k3]
 Set rng = WS.Columns("A:A").Find(What:=Clé, _
    LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    Cpt = rng.Row
    dest.[F7] = WS.Cells(Cpt, 2).Value
    dest.[G7] = WS.Cells(Cpt, 3).Value
    dest.[H7] = WS.Cells(Cpt, 4).Value
    dest.[I7] = WS.Cells(Cpt, 5).Value
    dest.[J7] = WS.Cells(Cpt, 6).Value
    dest.[K7] = WS.Cells(Cpt, 7).Value
    dest.[L3] = WS.Cells(Cpt, 8).Value
    Patch = ThisWorkbook.Path
    Img = False
    On Error Resume Next
    Strfile = Dir(Patch & "\" & [L3].Value & ".*")
    Do While Len(Strfile) > 0
        If Len(Strfile) <> 0 Then
            Img = True
            Imgfile = Strfile
            Exit Do
            Else
        End If
    Loop
    If Img = True Then
        Me.Image1.Picture = LoadPicture(Patch & "\" & Imgfile)
        Me.Image1.PictureSizeMode = fmPictureSizeModeZoom
        Me.Image1.Left = [L6].Left: Me.Image1.Top = [L6].Top
        On Error GoTo 0
        Else
        MsgBox ("الصورة غير متوفرة")
        Me.Image1.Picture = Nothing
    End If
End If
End Sub

 

test.rar

[سمير الليل]

شكرا