ماهو الحل في هذا الكود

[حاتم مبروك]

السلام عليكم ورحمة الله وبركاته 

 

 

الاساتذة الكرام 

 

استخدمت الكود الموجود في ملف الاستاذ سعيد بيرم والاستاذ حمادة عمر والكود عبارة عن استعلام بالرقم او الكود ولكن اريد تغيرة الى استعلام بالاسم 

 

وهذا هو الكود  وجزاكم الله خير

 

 

Private Sub ComboBox1_Change()

Set sh2 = Sheets("معارض ")

LR = sh2.[d2000].End(xlUp).Row

For Each cl In sh2.Range("A2:u" & LR)

If Me.ComboBox1.Text = cl Then

Me.TextBox21 = cl.Offset(0, 0)

Me.TextBox1 = cl.Offset(0, -3)

Me.TextBox2 = cl.Offset(0, -2)

Me.TextBox3 = cl.Offset(0, -1)

Me.TextBox4 = cl.Offset(0, 1)

Me.TextBox5 = cl.Offset(0, 2)

Me.TextBox6 = cl.Offset(0, 3)

Me.TextBox7 = cl.Offset(0, 4)

Me.TextBox8 = cl.Offset(0, 5)

Me.TextBox9 = cl.Offset(0, 6)

Me.TextBox10 = cl.Offset(0, 7)

Me.TextBox11 = cl.Offset(0, 8)

Me.TextBox12 = cl.Offset(0, 9)

Me.TextBox13 = cl.Offset(0, 10)

Me.TextBox14 = cl.Offset(0, 11)

Me.TextBox22 = cl.Offset(0, 12)

Me.TextBox23 = cl.Offset(0, 13)

Me.TextBox24 = cl.Offset(0, 14)

Me.TextBox25 = cl.Offset(0, 15)

Me.TextBox26 = cl.Offset(0, 16)

Me.TextBox27 = cl.Offset(0, 17)

'===========

'For ii = 4 To LR

'For i = 1 To 22

'If Me.ComboBox1.Text = .Cells(ii, 4).Value Then

Dim MyPick

    MyPick = ThisWorkbook.Path & "\" & Int(ComboBox1.Value) & ".JPG"

        If Right(MyPick, 1) <> "\" Then

            On Error GoTo 1

                Image1.Picture = LoadPicture(MyPick)

            Else

1:

        Image1.Picture = LoadPicture(ThisWorkbook.Path & "\M.JPG")

    Exit Sub

End If

 

End If

Next

End Sub

'Private Sub ComboBox1_Click()

'With Sheets(Label28.Caption)

'    LR = .[d2000].End(xlUp).Row

'        For ii = 4 To LR

'

'            For i = 1 To 22

'                If Me.ComboBox1.Text = .Cells(ii, 4).Value Then

'             Me.Controls("TextBox" & i).Value = .Cells(ii, i).Value

'        End If

'    Next

'Next

'End With

''TextBox4.Value = ComboBox1.Value: TextBox21.Value = CDate(TextBox21)

''TextBox5.Value = CDate(TextBox5): TextBox7.Value = CDate(TextBox7)

''TextBox8.Value = CDate(TextBox8): TextBox11.Value = CDate(TextBox11)

'Dim MyPick

'    MyPick = ThisWorkbook.Path & "\" & Int(TextBox1.Value) & ".JPG"

'        If Right(MyPick, 1) <> "\" Then

'            On Error GoTo 1

'                Image1.Picture = LoadPicture(MyPick)

'            Else

'1:

'        Image1.Picture = LoadPicture(ThisWorkbook.Path & "\M.JPG")

'    Exit Sub

'End If

'End Sub

[بن علية حاجي]

السلام عليكم ورحمة الله

 

أخي الكريم، يمكنك كفكرة أولى ربط القائمة المنسدلة للأسماء بالأرقام (الأرقام القومية) وتترك الكود يعطي الاستعلام بالرقم... أما إذا كنت تريد أن يعمل كود الاستعلام بالأسماء فهناك تغييرات كثيرة على هذا الكود وتغييرات على أسماء الصور ولأجل ذلك يجب إرفاق ملفك الخاص مع الكود (مع بعض البيانات) حتى يتسنى لنا كتابة وتغيير الكود حسب تنسيقات الملف... والله أعلم 

 

أخوك بن علية

[حاتم مبروك]

جزاك الله خير اخوي بن عليه اتفضل هذا الملف اللي اقصدة وهو ملف الاستاذ سعيد بيرم والاستاذ حمادة وفادني كثير جزاهم الله خير الجزاء

 

الكود يبحث بالرقم ولكن اريد تغيرة بان يبحث بالاسم وقد وضعت صورة في الملف باسم مكتب القصيم 

 

وجزاك الله خير

استعلام المكاتب.rar

[بن علية حاجي]

السلام عليكم ورحمة الله

 

أخي الكريم، يمكنك القيام بالتغييرات التالية :

* في الكود :

تغيير السطر

     "MyPick = ThisWorkbook.Path & "\" & Int(ComboBox1.Value) & ".JPG
بالسطر :

     "MyPick = ThisWorkbook.Path & "\" & ComboBox1.Value & ".JPG
* في مجلد الملفات :

     - تغيير امتداد الصور .JPEG بالامتداد .JPG

     - مطابقة كاملة لأسماء الصور مع أسماء المكاتب في ملف إكسيل (ملف البيانات) 

 

وكتطبيق لذلك يكفي النظر إلى الملف المرفق...

 

أخوك بن علية

 

استعلام المكاتب.rar

[حمادة عمر]

السلام عليكم

الأخ الكريم / حاتم مبروك

 

بارك الله فيك

هنيئا لك حل القدير الكبير / بن علية حاجي ... جزاه الله خيرا

وبالتأكيد بعد رده الراائع لا يوجد رد

فكم هو كبير اخي ... وقدير

جزاك الله خيرا

[حاتم مبروك]

الاستاذ بن عليه اشكر جزيل الشكر وجزاك الله خير يا مبدع 

 

الاستاذ حمادة عمر يشرفني تواجدك الله يعطيكم العافية