عنوان معدل - طلب فورم ادخال

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

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

 

 

اريد فورم للعمل من خلالة على هذا الملف وقد ارسلت الملف من قبل للاستاذ/القدير ضاحى الغريب وقام مشكورا بعمل الفورم ولكن لم اتمكن من البحث من خلالة لوجود بطئ عند البحث فارجوا مساعدتى فى حل هذة المشكلة

المطلوب اظهارة فى الفورم

1- البحث برقم القرار

2- البحث بالاسم

3-المسلسل

4-رقم القرار

5-تاريخ القرار

6-الاسم

7-مدة القرار

8-اجمالى القرار

9-المتبقى

10- المنصرف

وعمل زر طباعه للبيانات

 

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

ومرفق  اخر تحديث للملف

 

اسم المستخدم:حسام

كلمة المرور:حسام

 

كلمة مرورمحرر الاكود:2731987

كلمة مرور حماية اوراق العمل:2731987

 

http://www.gulfup.com/?9VcSsC

 

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

[احمد عبد الناصر]

السلام عليكم

 

استاذ حسام , معذرة علي التأخر في الرد

 

تحياتي لاستاذ ضاحي 

 

جرب هذه المحاولة 

 

https://dl.dropboxusercontent.com/u/44618320/8-6-2013%D9%86%D9%81%D9%82%D9%87%20%D8%A7%D8%AE%D8%B1%20%D8%A7%D9%84%D8%AA%D8%AD%D8%AF%D9%8A%D8%AB_%D9%85%D8%B9%D8%AF%D9%842.rar

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

اخى الاستاذ/ احمد عبدالناصر

الفورم يعمل جيدا 

ولكن اريد بعض الملاحظات ارجوا ان تتقبلها منى 

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

تقبل تحياتى

[احمد عبد الناصر]

السلام عليكم

 

بدل الكود السابق بهذا و اعلمني بالنتيجة 

Private Sub cmd_Click()
Dim t1, t2, y, x, c, f, t, tt, i
list.Clear
If txt1.Text <> "" Then t1 = WorksheetFunction.CountIf(Range("b12:b" & Range("b" & Rows.Count).End(xlUp).Row), txt1.Text)
If txt2.Text <> "" Then t2 = WorksheetFunction.CountIf(Range("d12:d" & Range("b" & Rows.Count).End(xlUp).Row), "*" & txt2.Text & "*")
If t1 + t2 > 0 Then
t = IIf(t1 > t2, t1, t2)
Dim arr()
ReDim arr(1 To 8, 1 To t + 1)
For y = 1 To 8
arr(y, 1) = Range("a7").Offset(0, y - 1)
Next

If txt1.Text <> "" Then
If txt2.Text <> "" Then
With Range("b:b")
    Set c = .Find(txt1.Text, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        f = c.Address
        Do
            If InStr(c.Offset(0, 2), txt2.Text) > 0 Then
            For y = 1 To 8
             arr(y, x + 2) = c.Offset(0, y - 2)
            Next
            x = x + 1
            End If

            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> f
    End If
End With
Else
With Range("b:b")
    Set c = .Find(txt1.Text, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        f = c.Address
        Do
            For y = 1 To 8
             arr(y, x + 2) = c.Offset(0, y - 2)
            Next
            x = x + 1

            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> f
    End If
End With

End If

Else

With Range("d:d")
    Set c = .Find(txt2.Text, LookIn:=xlValues, lookat:=xlPart)
    If Not c Is Nothing Then
        f = c.Address
        Do
            For y = 1 To 8
             arr(y, x + 2) = c.Offset(0, y - 4)
            Next
            x = x + 1

            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> f
    End If
End With

End If



ReDim Preserve arr(1 To 8, 1 To x + 1)
list.Column = arr

End If
End Sub

تحياتي

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

استاذى العزيز\ احمد عبدالناصر

لك منى كل التحية والتقدير شكرا على مجهودك الكبير الفورم يعمل جيدا وتم حل مشكلة البطء عند البحث

اريد كود لطباعه البيانات

وهل من الممكن تغيير حجم الخط فى اللست بوكس ام لا

وشكرا وجزاك الله كل خير وبارك الله فيك

[احمد عبد الناصر]

 

الفورم يعمل جيدا وتم حل مشكلة البطء عند البحث

 

حمدا لله 

 

 

اريد كود لطباعه البيانات

 

 

معذرة فليس لي خبرة في عممليات الطباعة و اكوادها .

 

 

وهل من الممكن تغيير حجم الخط فى اللست بوكس ام لا

 

 

جرب هذا الكود 

list.Font.Size = 18

تحياتي

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

 اخى العزيز /احمد عبدالناصر

 

تمت تجربة الكود ويعمل بنجاح ولكن عن عرض البيانات فى اللست بوكس

الاسم ورقم القرار والتاريخ وباقى البيانات الاساسية تظهر معكوسة من الشمال الى اليمين

مرفق صورة لتوضيح ما اقصد

تقبل تحياتى،،

 

untitled.rar

[ناصر سعيد]

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

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

الاخوة الكرام تم حل المشكلة بحمد الله بمساعدة الاستاذ القدير/عبدالله باقشير

 

واليكم الطريقة للمعرفة

 

اضغط على الصورة للتكبير