ابو محمد نصري

جعلها الله في ميزان حسناتك استاذ Mohamed Hicham شكرا الكود رائع 

لو سمحت استاذ ممكن كمان ترحيل الي صفحه 

لو سمحت بنسبه لي التاريخ البحث في TEXTBO1 OR TEXTBOX2 ممكن التعديل علي 

الكود لا يلتزم في التاريخ الي التاريخ

ComboBox1 هو اسم العميل عند اختيار اسم يتم فلتره داخل الليست بوكس 

TEXTBOX1 هو اجمالي الذي يظهر في الليست بوكس

يتم ترحيل المعلومات من الليست بوكس الي صفحه التصفية..يتم البحث عن المعلومات من صفحه BT

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

BOOK1.xlsm

للرفع

استاذ محمد انا عندي مديول 

Mohamed Hicham استاذ 

المطلوب في اليوزفورم كشف حساب تفصيلي  العميل  يبحث عن اسم العميل الموجود داخل 5 ورقات العمل 

اسم العميل ..من تاريخ ..الي تاريخ في اليوزرفورم و نتيجته في الليست بوكس 

Option Explicit
'      ÚäæÇä ÑÄæÓ ÇáÇÚãÏÉ
Public Const MyTopColmnRng As String = "B4:L4"

'  MyTopColmnRng   ÑÞã ÚãæÏ ÇÓã ÇáÍÓÇÈ ãä ÇáäØÇÞ
Private Const MyColmnFind As Integer = 5

'  MyTopColmnRng   ÑÞã ÚãæÏ ÇáÊÇÑíÎ ãä ÇáäØÇÞ
Private Const dColmn As Integer = 4
'======================================================
Dim ii As Long
'======================================================

Sub kh_Show()
    saad1.Show
End Sub

Sub kh_Start()
Dim N
'-------------------------
On Error GoTo kh_Ex
'-------------------------
With Range(MyTopColmnRng)
    ii = Cells(Rows.Count, .Column).End(xlUp).Row - .Row
    If ii Then .Offset(1, 0).Resize(ii).ClearContents
    ii = .Row + 1
End With
'-------------------------
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'-------------------------
For Each N In Array("Facture de Achats", "Facture de Vente", "Retour Achats", "Retour Vente", "ÎÒíäÉ")
    kh_AddItem CStr(N)
Next
'-------------------------
kh_Ex:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
'-------------------------
If Err Then
    MsgBox "Err.Number : " & Err.Number
    Err.Clear
Else
    If ii > Range(MyTopColmnRng).Row + 1 Then
        kh_Sort
        Range("L5", Cells(ii - 1, "L")).Value = "=SUM(R[-1]C,RC[-2])-SUM(RC[-1])"
        MsgBox "Êã ÇÚÏÇÏ ÇáÊÞÑíÑ ÈäÌÇÍ ", vbMsgBoxRight, "ÇáÍãÏááå"
    Else
        MsgBox "áÇ ÊæÌÏ äÊÇÆÌ ááÈÍË", vbMsgBoxRight, "ÚÝæÇ"
    End If
End If
End Sub
Sub kh_AddItem(nSh As String)
Dim MyRng As Range
Dim r As Integer
Dim ContRow As Long, i As Long
Dim tFindNum As String
Dim dt1 As Date, dt2 As Date
'-------------------------
On Error GoTo 1
'-------------------------
Set MyRng = Sheets(nSh).Range(MyTopColmnRng)
'-------------------------
With MyRng
    ContRow = .Worksheet.Cells(Rows.Count, .Column).End(xlUp).Row - .Row
End With
If ContRow = 0 Then Exit Sub
'-------------------------
'      ÇÓã ÇáÍÓÇÈ ÇáãØáæÈ
tFindNum = LCase(saad1.ComboBox1.Value)
'-------------------------
'       ÇáÊæÇÑíÎ
dt1 = CDbl(CDate(saad1.ComboBox2))
dt2 = CDbl(CDate(saad1.ComboBox3))
'-------------------------
With MyRng.Offset(1, 0)
    For r = 1 To ContRow
        Select Case .Cells(r, dColmn).Value2: Case dt1 To dt2
            If LCase(.Cells(r, MyColmnFind)) Like tFindNum Then
                ''''''''''''''''''''''''''''''''
                'ãËáÇ åÐå ÇáÇÚãÏÉ ãØáæÈÉ Ýí ßá ÇáÍÓÇÈÇÊ
                Cells(ii, "B").Resize(1, 6).Value = .Cells(r, 1).Resize(1, 6).Value
                ' ÇáãÚíÇÑ ÇÓã ÇáæÑÞÉ
                Select Case .Worksheet.Name
                'ÈÇÞí ÇáÇÚãÏÉ æåí ÇÑÈÚÉ äÎÊÇÑ ÝíåÇ ãÇäÑíÏå
                    Case "Facture de Achats", "Retour Vente"
                        Cells(ii, "H").Resize(1, 4).Value = Array(.Cells(r, 7).Value, .Cells(r, 8).Value, "", .Cells(r, 9).Value)
                    Case "Facture de Vente", "Retour Achats"
                        Cells(ii, "H").Resize(1, 4).Value = Array(.Cells(r, 7).Value, .Cells(r, 8).Value, .Cells(r, 9).Value, "")
                    Case "ÎÒíäÉ"
                        Cells(ii, "H").Resize(1, 4).Value = Array("", "", .Cells(r, 7).Value, .Cells(r, 8).Value)
                End Select
                ''''''''''''''''''''''''''''''''''''
                ii = ii + 1
            End If
        End Select
    Next
End With
'-------------------------
1:
Set MyRng = Nothing
End Sub
sub kh_Sort()
Dim c As Integer
With saad1
    If .CheckBox1.Value Then c = .ComboSort.ListIndex + 1
End With
If c = 0 Then Exit Sub
''''''''''''''''''''''''''''''''
With Range(MyTopColmnRng).Offset(1, 0).Resize(ii)
    .Sort .Columns(c), xlAscending
End With
End Sub

هيدا المديول ممكن اطبقه علي الليست بوكس 

Module4.rar

السلام عليك ارجو المساعده في كشف حساب العميل من 5 ورقات عمل 

A.xlsm

Mohamed Hicham شكرا

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

اسم صفحه , تضهر رقم اخر فاتوره بصفحه في textbox1 

اذا كان اختير اسم الصفحه Facture de Achats تبدا الفاتوره من رقم 1000

اذا كان اختير اسم الصفحه Facture de Vente تبدا الفاتوره من رقم 100..مع العلم يوجد 4 صفحات 

انتبه من فضلك فلما تم فتح الموضوع مرة أخرى على الرغم انه انتهت كل الطلبات بالمشاركة ؟!!!

AA.xlsm

نعم 

 tb10 قيمه الفاتوره 

المره جاي كود استدعاء الفاتوره ..لو سمحت ممكن استاذ اذا كانت نسبة الضريبة موجوده يرحلي  tb10 قيمه الفاتوره  مع نسبه المجموع اجمالي 

ممكن نرحل tb10 قيمه الفاتوره  الي العمود J لو سمحت 

لو سمحت استاذ ممكن ترفعلي الملف مره تانيه لو سمحت

عند الغاء نسبه الضريبه تختفي من اليوزفورم ...المشكله في ترحيل نسبه ( عند الغاء نسبه ضريبة لا اريد ترحيلها لي شيت

TextBox1 اذا ممكن نعمل كود الفاتوره لو سحمت

لو سمحت استاذ ممكن عند الغاء نسبه الضريبة CheckBox3  لا يتم ترحيل النسبة..مع عمل كود الفاتوره لو سمحت  

وعليك السلام اخي نعم 

استاذ Mohamed Hicham شكرا علي اهتمامك 

مثل " اليست بوكس فيها 10 اصناف او اكتر ..اريد ترحيل نسبه الضريبه لي كل صنف موجود بالليست بوكس ..وليس اجمالي 

السلام عليكم لو سمحتم ممكن مساعده في تعديل علي كود ترحيل الفاتوره ..._(الكود ترحيل يعمل جيد) المطلوب ترحيل tb8 هو عباره عن نسبه الضريبة 

ترحيل الضريبة كل صنف الي العمود L

AAAAA.xlsm

ماشاءالله عليك ربي يحميك استاذ  

استاذ Mohamed Hicham

شكرا علي المجهود مشاء الله عليك ( لو سمحت ممكن ترتيب التاريخ من اصغر الي اكبر )

نعم نفس الفورم استاذ  ..ويكون التاريخ بل ترتيب 

نعم انت صار عندك جمع اسماء الفواتير في العمود اول من اليست بوكس والعمود رقم 4 صار فيه اعداد