ابو محمد نصري

جعلها الله في ميزان حسناتك استاذ 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 لو سمحت

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