mahmoud nasr alhasany

جميل حقا

Private Sub CommandButton3_Click() ListBox1.Clear Dim x() As Variant Set f = Sheets(1): x = Array("ListBox1", "ListBox2") For i = 0 To UBound(x): Me.Controls(x(i)).Clear:: Next i Set d = CreateObject("Scripting.Dictionary") Set arr = f.Range("A2:E" & f.[A65000].End(xlUp).Row): a = arr.Value Dim tmp(): ReDim tmp(1 To UBound(a)) For i = LBound(a) To UBound(a) c = a(i, 3): Results = Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5)) If OptionButton1 = True And c > Date And c <= CDate(WorksheetFunction.EDate(Date, 48)) Or _ OptionButton2 = True And c > Date And c <= CDate(WorksheetFunction.EDate(Date, 3)) Or _ OptionButton3 = True And c > Date And c <= CDate(WorksheetFunction.EDate(Date, 6)) Or _ OptionButton4 = True And c > Date And c <= CDate(WorksheetFunction.EDate(Date, 12)) Then n = n + 1: tmp(n) = i ReDim Preserve tmp(1 To n + 1) Me.ListBox1.List = Application.Index(a, Application.Transpose(tmp), _ Application.Transpose(Evaluate("Row(1:" & UBound(a, 2) & ")"))) Me.ListBox1.RemoveItem n ElseIf c > 0 And c <= (Date) Then d(i) = Results End If Next n = d.Count If n > 0 And Me.OptionButton1 = True Or Me.OptionButton2 = True Or _ Me.OptionButton3 = True Or Me.OptionButton4 = True Then Dim cnt: cnt = Application.Transpose(d.items) ReDim Preserve cnt(1 To 5, 1 To n + 1) Me.ListBox2.List = Application.Transpose(cnt) Me.ListBox2.RemoveItem n End If For i = 0 To UBound(x) With Me.Controls(x(i)) .ColumnCount = 5: .ColumnWidths = "55;50;80;50;50" End With Next i End Sub لقد وجد الحل هل يكفى ام يوجد كود اخر مختلف If OptionButton1= True And c > Date And c <= CDate(WorksheetFunction.EDate(Date, 48))Or _ OptionButton2 = True And c > Date And c <= CDate(WorksheetFunction.EDate(Date, 3)) Or _ OptionButton3 = True And c > Date And c <= CDate(WorksheetFunction.EDate(Date, 6)) Or _ OptionButton4 = True And c > Date And c <= CDate(WorksheetFunction.EDate(Date, 12)) Then بدل هذا الكود If OptionButton1 = True And c > Date And c <= (Date + 720) Or _ OptionButton2 = True And c > Date And c <= (Date + 90) Or _ OptionButton3 = True And c > Date And c <= (Date + 180) Or _ OptionButton4 = True And c > Date And c <= (Date + 360) Then message for expiring items1 V4.xlsm

احسنت 1 محمد هشام انه كود حقا رائع انه يعمل حقا اريد استفسار بالنسبة لهذه الاكواد التى تشمل عدد الايام المقسمة الى 3 اشهر او 6 اشهر او 12 شهرا (سنة) او 48 شهرا (سنتان) OptionButton1 = True And c > Date And c <= (Date + 720) OptionButton2 = True And c > Date And c <= (Date + 90) OptionButton3 = True And c > Date And c <= (Date + 180) OptionButton4 = True And c > Date And c <= (Date + 360) كمثال (Date + 90) لو وجدنا ان 90 يوما كمثال شهرمايو يونيو ويوليو =92 يوما وليس 90 وهكذا فى باقى الاشهر اذا كانت المعادلة 720 او 360 او 180 او 90 هل يوجد صيغة بدل الارقام لتكون الاستعلام صحيحا وشكرا لك

لقد تم ايجاد الحل انظر الكود رجاء ا/ محمد هشام لقد اضفت عليها تحديد كل صيغ OptionButton ام يوجد افضل من هذا كود مختصر اقصد نريد ان نتعلم من روائعك ا/ محمد هشام ملحوظة يوجد بيانات لاتدرج فى الليست بوكس 1 او 2 26723 F16E 10/07/2024 0 days validity expires yet 0 year, 0 month And 0 days هى بأختصار البيانات التى تكون متوافه فى هذا اليوم تكون 0 يوم اكسبير نهاية اليوم رجاء كيف ادرجها فى الليست بوكس 2 مع العلم انها إذا كان يتوافق اليوم نهاية الاكسبير يجب أن تدرج فى الليست بوكس ٢ Private Sub CommandButton3_Click() ListBox1.Clear Dim x() As Variant Set f = Sheets(1) x = Array("ListBox1", "ListBox2") Set d = CreateObject("Scripting.Dictionary") Set arr = f.Range("A2:e" & f.[A65000].End(xlUp).Row): a = arr.Value Dim tmp(): ReDim tmp(1 To UBound(a)) For i = LBound(a) To UBound(a) c = a(i, 3): Results = Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5)) If OptionButton1 = True Then If c > Date And c < (Date + 720) Then n = n + 1: tmp(n) = i ReDim Preserve tmp(1 To n + 1) Me.ListBox1.List = Application.Index(a, Application.Transpose(tmp), _ Application.Transpose(Evaluate("Row(1:" & UBound(a, 2) & ")"))) Me.ListBox1.RemoveItem n ElseIf c > 0 And c < (Date) Then d(i) = Results End If ElseIf OptionButton2 = True Then If c > Date And c < (Date + 90) Then n = n + 1: tmp(n) = i ReDim Preserve tmp(1 To n + 1) Me.ListBox1.List = Application.Index(a, Application.Transpose(tmp), _ Application.Transpose(Evaluate("Row(1:" & UBound(a, 2) & ")"))) Me.ListBox1.RemoveItem n ElseIf c > 0 And c < (Date) Then d(i) = Results End If ElseIf OptionButton3 = True Then If c > Date And c < (Date + 180) Then n = n + 1: tmp(n) = i ReDim Preserve tmp(1 To n + 1) Me.ListBox1.List = Application.Index(a, Application.Transpose(tmp), _ Application.Transpose(Evaluate("Row(1:" & UBound(a, 2) & ")"))) Me.ListBox1.RemoveItem n ElseIf c > 0 And c < (Date) Then d(i) = Results End If ElseIf OptionButton4 = True Then If c > Date And c < (Date + 360) Then n = n + 1: tmp(n) = i ReDim Preserve tmp(1 To n + 1) Me.ListBox1.List = Application.Index(a, Application.Transpose(tmp), _ Application.Transpose(Evaluate("Row(1:" & UBound(a, 2) & ")"))) Me.ListBox1.RemoveItem n ElseIf c > 0 And c < (Date) Then d(i) = Results End If End If Next n = d.Count If n > 0 Then Dim Cnt: Cnt = Application.Transpose(d.items) ReDim Preserve Cnt(1 To 5, 1 To n + 1) Me.ListBox2.List = Application.Transpose(Cnt) Me.ListBox2.RemoveItem n End If For i = 0 To UBound(x): Me.Controls(x(i)).ColumnCount = 5: Next i End Sub message for expiring items1 V3.xlsm

مشكور اخى محمد هشام كود رائع هل اكملت الاستعلام لو تم تحديده عن طريق OptionButton1,2,3,4 مع العلم ان كل OptionButton تم تحديد الاستعلام البيانات التى يكون صلاحيتها بداية من اليوم حتى الفترة الزمنية المحدده لها عند الانتهاء وذلك عند اختيار All and 3Month and 6Month 12Month عن طريق (صلاحية معينة ) CommandButton3 message for expiring items1 V3.xlsm

السلام عليكم ورحمة الله وبركاتة الرجاء مساعدتى فى تحويل كود msg الى CommandButton1 استعلام listbox1,2 وهذا الكود يرمز عند فتح الملف يأتى بالصلاحيات خاصة بمنتجات قريبة الصلاحية ومنتجات انتهت صلاحيتها Private Sub CommandButton1_Click() Dim c As Range, exp As String, msg As String With Sheets(1) For Each c In .Range("C2", .Cells(Rows.Count, 3).End(xlUp)) If c <> "" Then If c.Value > Date + 6 And c.Value < (Date + 30) Then exp = exp & c.Offset(, -2).Value & " - " & c.Offset(, -1).Value & " - " & c.Value & vbLf ElseIf c.Value < (Date + 6) Then msg = msg & c.Offset(, -2).Value & " - " & c.Offset(, -1).Value & " - " & c.Value & vbLf End If End If Next End With MsgBox exp, vbInformation, "العناصر التي تنتهي صلاحيتها قريبًا" If msg <> "" Then MsgBox "يرجى الإزالة المنتجات من مواقع الأرفف وإزالة البيانات من الملف." & vbNewLine & msg, vbExclamation, "العناصر منتهية الصلاحية" End If End Sub message for expiring items1.xlsm

احسنت ا/ محمد هشام انت رائع

السلام عليكم ورحمة الله وبركاتة الرجاء المساعدة فى عمل كود طباعة بواسطة PDF And Word Private Sub WordView_Click() End Sub and Private Sub PDFConvertor_Click() End Sub Private Sub WordView_Click() End Sub and Private Sub PDFConvertor_Click() End Sub كرت الصنف 2024.xlsm

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

مثل هذه

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

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

Private Sub Image1_Click() Sheet5.Select Cells.Select Sheet5.Range("a1:h3999").ClearContents Selection.Clear Range("A1").Select Application.ScreenUpdating = False Sheet5.Cells(1, 1) = " من تاريخ " Sheet5.Cells(1, 2) = Me.TextBox1 Sheet5.Cells(2, 1) = " الى تاريخ " Sheet5.Cells(2, 2) = Me.TextBox2 Sheet5.Cells(1, 4) = "اسم المخزن" Sheet5.Cells(1, 5) = ComboBox1 Sheet5.Cells(2, 4) = "اسم الصنف" Sheet5.Cells(2, 5) = ComboBox2 Sheet5.Cells(1, 6) = " رصيداول مدة " Sheet5.Cells(2, 6) = TextBox3 Sheet5.Cells(3, 1) = "رقم المستند" Sheet5.Cells(3, 2) = "التاريخ" Sheet5.Cells(3, 3) = "نوع الحركة" Sheet5.Cells(3, 4) = "اسم المخزن" Sheet5.Cells(3, 5) = "اسم الصنف" Sheet5.Cells(3, 6) = "شراء" Sheet5.Cells(3, 7) = "بيع" Sheet5.Cells(3, 8) = "الرصيد" a = Sheet5.Range("d500").End(xlUp).Row For I = 0 To Me.ListBox1.ListCount - 1 For x = 0 To 7 Sheet5.Cells(I + 4, x + 1) = Me.ListBox1.List(I, x) Next x Next I Unload Me Sheet5.PrintPreview Sheet5.Select End Sub مساعدة فى تنسيق ورقة العمل sheet5 بحيث تكون منسقة فى الطباعة فعند الاستعلام بأسم المخزن واسم الصنف بين تاريخين مع استخدام امر بحث من option تكون ورقة الطباعة بشكل مسطر ومنسق كرت الصنف 2024.xlsm

هو برنامج محاسبى مجانى مفتوح المصدر عند كتابة اليوزرنيم يقوم بالاغلاق مع العلم ان اسم الادمن admin والباسورد 123 الرجاء مساعدتى فى ايجاد المشكله التى يتعرض لها البرنامج EASY_SALE.zip

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

احسنت ا/ حسونة حسين بارك الله فيك

ممتاذ احسنت استاذ / محمد هشام

احسنت ا/ محمد هشام

لقد صممت كارت الصنف للمخازن يوضح المخزون والكميات الواردة والكميات الصادرة والكميات المتاحة مع رصيد افتتاحى واستعلام كلى او مخزن معين بين تاريخين الرجاء استكمال الفورم بخصوص الطباعة بأكثر من صيغة سواء وورد او اكسيل او بى دى اف وبشكل منسق وايضا الرجاء ان يكون الخيار الطباعة من خلال الملف او ملف اكسيل خارجى وارجو من الاستاذ حسونة حسين كرت الصنف 2024.xlsmو الاستاذ محمد هشام ان يلقوا نظرة سريعة بخصوص الفورم وطريقة عملة هل مجدية ام يوجد اصلاحات عليها وشكر ا لكم كرت الصنف 2024.xlsm

فاتورة خبوريه من اعمال السيد/ ضاحى غريب والسيد / عبدلله باقشير

احسنت وبارك الله فيك ا/ محمد هشام

احسنت ا/محمد هشام هذا هو المطلوب بارك الله فيك

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

هذا هو الملف نوع السعر على حسب كود الصنف بيانات فاتورة2.xlsm

الف شكر استاذنا محمد هشام عزرا أننى لم اقم بتوضيح السؤال الثانى جيدا أما بخصوص Combobox 10 فهو خاص بقائمة الاسعار كسبيل المثال القائمة الافقى وهى السعر سعر الشراء سعر البيع سعر كبار عملاء سعر التجزئه تكون بياناتها فى Combobox 10 وعند اختيار كل بيان من Combobox 10 بما ذكرته بما يقابلها من سعر على حسب كود الصنف مثال Combobox 10 اختيار سعر الشراء من القائمة ثم كود الصنف وهو 101 السعر بمايقابلها فى Textbox7 105 وهكذا فى مع باقى البيانات مثل كبار عملاء . جمله .تجزئه