اريد عمل فورم لاضافة التحاليل الطبية لكل مريض والبحث عنه

[حسام عبدالمحسن]

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

 

الى عمالقة المنتدى جزاهم الله كل خير

مرفق لكم شيت اكسيل اود عمل فورم لة للعمل من خلال الفورم بحيث يمكن اضافة التحاليل الطبية لكل مريض والبحث عنه من خلال الفورم     

حيث ان كل جدول موجود فى الشيت خاص باسم مريض وهكذا الجدول الثانى باسم اخر

 

ارجوا ان اكون قد وصلت لكم ما اريد ولكم جزيل الشكر والاحترام

وجدة الغسيل الكلوىc.rar

[حسام عبدالمحسن]

للرفع

[الشهابي]

أخي العزيز / أبو ندى 

هذا طريقة  باستخدام فورم أستاذنا القدير العلامة / عبد الله باقشير 

تم إضافة سطر بعد سطر العناوين من أجل جعل العناوين كلها في سطر واحد قم بإخفائها فيما بعد

وستلاحظ ذلك عند تشغيل الفورم

كما تم نسخ رقم المسلسل للمريض في الخلية المقابلة له في العمود (A) لأن دمج الخلاياء كان عائق في الوصول للمطلوب 

فتم عمل ذلك للتخلص من الدمج 

أنا لست خبيراً في الأكواد وإلا فعلت لك من أكثر من ذلك

هذا ما استطعت أن أقدمه لكم حسب أمكانيتنا 

تقبل تحياتي وتقديري

والعفو

وجدة الغسيل الكلوىc.rar

[حسام عبدالمحسن]

""اخى الشهابى تعجز الكلمات عن الشكر الفورم يعمل جيدا جزاك الله كل خير وجعله فى ميزان حساناتك""

[حسام عبدالمحسن]

اخى العزيز الشهابى اريد زيادة عدد الجداول  ولكن المعادل الموجودة بالاعلى لاتعمل مع اكثر من 11 جدول او11 مسلسل فقط

[الشهابي]

أخي العزيز / أبو ندى 

استبدل المعادلة في الخلية (H1)  بهذه المعادلة

=ADDRESS(MATCH(C2;A4:A1000;0)+13;2;1;1)&":"&ADDRESS(MATCH(C2;A4:A1000;0)+13;16;1;1)

ويمكنك زيادة الرقم في دالة ( MATCH) من (A4) إلى أكثر (A1000 ) مثلا (A2000) أوأكثر 

كما أضفت لك معادلة في الخلية (J1) لتحديد آخر خلية فيها بيانات في الجدول

فقط عليك الذهاب  إلى كود الفورم وتعدل السطر هذا في هذا الكود

Sub kh_SetAddrss(ByVal MySht As String, ByVal MyAddrs As String, Optional ByVal aSr As String = "")
tSr = TypeName(Evaluate(aSr)) = "Range"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With ThisWorkbook
    If tSr Then Set MyRngSeri = .Worksheets(MySht).Range(aSr)
    Set MyRngdate = .Worksheets(MySht).Range(MyAddrs)
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With MyRngdate
    ContRow = .Worksheet.Cells(Rows.Count, .Column).End(xlUp).Row - .Row
    LastColumn = .Cells.Count
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Col As Range
Dim ii As Integer
ReDim Ar(1 To LastColumn)
For Each Col In MyRngdate.Cells
    ii = ii + 1
    Ar(ii) = Col.Column - MyRngdate.Column + 1
Next
'''''''''''''''''''''''''''
End Sub

استبدل هذا السطر 

ContRow = .Worksheet.Cells(Rows.Count, .Column).End(xlUp).Row - .Row

بهذا السطر

  ContRow = .Worksheet.Range("INDIRECT(j1)").End(xlUp).Row - .Row

وهذا الملف بعد إضافة التعديلات المطلوبة

وجدة الغسيل الكلوىc.rar

[عبدالله باقشير]

السلام عليكم ورحمة الله وبركاته
 
اخي الحبيب الشهابي ............حفظكم الله
ممتاز جدا...توضيب رائع للتعامل مع الفورم وفكر راقي

 

 
 
تقبلوا تحياتي وشكري

[حسام عبدالمحسن]

اخى الشهابى لقد حاولت زيادة عدد الجداول وعند اختيار رقم المسلسل والضغط على انتر يظهر خطأ بالمعادلة

فهل من الممكن قيامك بالتعديل المطلوب وهو زيادة عدد الجداول الموجودة الى 50 جدول لانى حاولت كثيرا عمل هذا ولم افلح هذا هو المطلوب وجزاك الله كل خير

[الشهابي]

أستاذي العزيز ومعلمنا القدير / عبد الله باقشير 

هذا بفضلكم وبفضل تعليمكم لنا 

وما هي إلا محاولة فقط كما قلت لتوظيب التعامل مع الفورم الذي هو درة من درر أعمالكم التي لا مثيل لها 

شكراً أستاذنا الكبير على تشجعيكم لنا 

جزاكم الله خير وحفظكم الله ورعاكم 

[الشهابي]

أخي العزيز / أبو ندى 

لابد  أن يكون التباعد بين الجداول متساوي في عدد الصفوف وربما هو السبب في الأخطاء

المهم قمت بالتعديل وإضافة الجداول إلى (50 ) جدول ويمكنك أيضا الزيادة على ذلك 

بس انتبه لتساوي عدد الأسطر عند الإضافة 

وجدة الغسيل الكلوىc.rar

[أم عبد الله]

أستاذنا الكبير / الشهابي

 

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

 

جزاك الله خيراً على هذا العمل الرائع والمتقن . جعله الله في ميزان حسناتك وزادك الله من فضله وعلمله. لك كل التحية والتقدير.

[الشهابي]

الأستاذة الكريمة / أم عبد الله 

يشرفني مروركم الكريم

جزاكم الله خير على تشجعيكم ودعاؤكم لنا 

تحياتي وتقديري

[حسام عبدالمحسن]

اخى العزيز الشهابى تمت تجربة زيادة الجداول والفعل الملف يعمل جيدا واشكرك كثيرا على مساعدتك لى

وجزاك الله كل خير واعانك على  فعل الخير