المساعدة في كود كشف حساب عن طريق اليوزرفورم

[ابو محمد نصري]

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

A.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

[ابو محمد نصري]

للرفع