mahmoud nasr alhasany

وجدت الحل بحمدلله
Private Sub CheckBox1_Click() Dim arr() As Variant Dim i As Long, j As Long, temp As Variant Dim sortColumn As Integer Dim sortOrder As Boolean ' نسخ البيانات من ListBox إلى المصفوفة ReDim arr(ListBox1.ListCount - 1, ListBox1.ColumnCount - 1) For i = 0 To ListBox1.ListCount - 1 For j = 0 To ListBox1.ColumnCount - 1 arr(i, j) = ListBox1.List(i, j) Next j Next i ' تحديد عمود الفرز بناءً على ComboBox sortColumn = ComboBox1.ListIndex ' تحديد اتجاه الفرز بناءً على CheckBox sortOrder = CheckBox1.Value ' الفرز باستخدام Bubble Sort For i = LBound(arr) To UBound(arr) - 1 For j = i + 1 To UBound(arr) If sortOrder Then ' ترتيب تنازلي If IsNumeric(arr(i, sortColumn)) Or IsNumeric(arr(j, sortColumn)) Then If CDbl(arr(i, sortColumn)) > CDbl(arr(j, sortColumn)) Then ' تبادل السجلين For k = LBound(arr, 2) To UBound(arr, 2) temp = arr(i, k) arr(i, k) = arr(j, k) arr(j, k) = temp Next k End If Else If UCase(arr(i, sortColumn)) > UCase(arr(j, sortColumn)) Then ' تبادل السجلين For k = LBound(arr, 2) To UBound(arr, 2) temp = arr(i, k) arr(i, k) = arr(j, k) arr(j, k) = temp Next k End If End If Else ' ترتيب تصاعدي If IsNumeric(arr(i, sortColumn)) Or IsNumeric(arr(j, sortColumn)) Then If CDbl(arr(i, sortColumn)) < CDbl(arr(j, sortColumn)) Then ' تبادل السجلين ' تبادل السجلين For k = LBound(arr, 2) To UBound(arr, 2) temp = arr(i, k) arr(i, k) = arr(j, k) arr(j, k) = temp Next k End If Else If UCase(arr(i, sortColumn)) < UCase(arr(j, sortColumn)) Then ' تبادل السجلين ' تبادل السجلين For k = LBound(arr, 2) To UBound(arr, 2) temp = arr(i, k) arr(i, k) = arr(j, k) arr(j, k) = temp Next k End If End If End If  

' تحديث المخزون بناءً على الفرق في الكمية lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock If wsStock.Cells(j, "B").Value = fromStore Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value + quantityDiff ' إضافة أو طرح الفرق من المخزن الأصلي ElseIf wsStock.Cells(j, "B").Value = toStore Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value - quantityDiff ' خصم الفرق من المخزن الآخر wsStock.Cells(j, "M").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "N").Value = Environ("Username") ' اسم المستخدم End If Next j End If Next i 'تم تعديلة الى العكس السالب والموجب' ' تحديث المخزون بناءً على الفرق في الكمية lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock If wsStock.Cells(j, "B").Value = fromStore Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value - quantityDiff ' إضافة أو طرح الفرق من المخزن الأصلي ElseIf wsStock.Cells(j, "B").Value = toStore Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value + quantityDiff ' خصم الفرق من المخزن الآخر wsStock.Cells(j, "M").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "N").Value = Environ("Username") ' اسم المستخدم End If Next j End If Next i تم تعديلة الى العكس السالب والموجب'
لتنجح الفكرة شكرا ا/محمد هشام على المجهود الرائع
 

تم ايجاد المشكلة بحمدلله الخاص بتعديل الكمية وارجاعها للمخزنين سواء خصم اوزيادة فى احداهما
يوجد كودين
Private Sub CommandButton2_Click() ' ... rest of your code ... Dim wsSales As Worksheet, wsStock As Worksheet Dim lastRowSales As Long, lastRowStock As Long Dim i As Long, j As Long Dim invoiceNo As Long, fromStore As String, toStore As String, itemCode As String, quantity As Long, newQuantity As Long Dim quantityDiff As Long 'رقم الفاتورة invoiceNo = Val(TextBox2.Value) ' ComboBox1 المخزون الاول fromStore = ComboBox1.Value ' ComboBox2 المخزون الثانى toStore = ComboBox2.Value ' ComboBox1 رصيد المخزون الاول fromStore1 = stocktr.Value ' ComboBox2 رصيد المخزون الثانى toStore2 = stocktrr.Value 'شيت مبيعات Set wsSales = Worksheets("Transferts") 'شيت المخزون Set wsStock = Worksheets("Inventaire") 'ابحث عن الفاتورة في ورقة المبيعات lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRowSales If wsSales.Cells(i, "A").Value = invoiceNo Then ' احصل على الكمية الجديدة من المستخدم (مثال: عن طريق TextBox) newQuantity = Val(TextBox1.Value) ' احسب فرق الكمية quantity = wsSales.Cells(i, "H").Value quantityDiff = newQuantity + quantity ' قم بتحديث الكمية في ورقة المبيعات wsSales.Cells(i, "H").Value = newQuantity wsSales.Cells(i, "k").Value = Now() ' تاريخ التعديل wsSales.Cells(i, "l").Value = Environ("Username") ' اسم المستخدم End If Next i ' ابحث عن الفاتورة في ورقة المخزون lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock If wsStock.Cells(j, "A").Value = fromStore Then ' احصل على الكمية الجديدة من المستخدم (مثال: عن طريق TextBox) newQuantity = Val(TextBox1.Value) quantity = wsStock.Cells(j, "D").Value quantityDiff = newQuantity - quantity ' قم بتحديث الكمية في ورقة المبيعات wsStock.Cells(j, "D").Value = newQuantity + fromStore1 ' تحديث الكميات في المخزون ' ... (نفس الكود السابق لإرجاع الكميات) ElseIf wsStock.Cells(j, "A").Value = toStore Then ' احصل على الكمية الجديدة من المستخدم (مثال: عن طريق TextBox) newQuantity = Val(TextBox1.Value) ' احسب فرق الكمية quantity = wsStock.Cells(j, "D").Value quantityDiff = newQuantity + quantity ' قم بتحديث الكمية في ورقة المبيعات wsStock.Cells(j, "D").Value = toStore2 - newQuantity wsStock.Cells(j, "J").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "K").Value = Environ("Username") ' اسم المستخدم End If Next j MsgBox "تم تعديل الفاتورة وإرجاع الكميات بنجاح" End Sub  
 
Private Sub CommandButton2_Click() Dim wsSales As Worksheet, wsStock As Worksheet Dim lastRowSales As Long, lastRowStock As Long Dim i As Long, j As Long Dim invoiceNo As Long, fromStore As String, toStore As String, itemCode As String, quantity As Long, newQuantity As Long Dim quantityDiff As Long invoiceNo = Val(TextBox2.Value) ' ComboBox1 المخزون الاول fromStore = ComboBox1.Value ' ComboBox1 المخزون الاول toStore = ComboBox2.Value ' ComboBox1 قيمة المخزون الاول fromStore1 = stocktr.Value ' ComboBox2 قيمة المخزون الثانى toStore2 = stocktrr.Value Set wsSales = Worksheets("Transferts") Set wsStock = Worksheets("Inventaire") lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRowSales If wsSales.Cells(i, "A").Value = invoiceNo Then newQuantity = Val(TextBox1.Value) quantity = wsSales.Cells(i, "H").Value quantityDiff = newQuantity + quantity wsSales.Cells(i, "H").Value = newQuantity wsSales.Cells(i, "k").Value = Now() ' تاريخ التعديل wsSales.Cells(i, "l").Value = Environ("Username") ' اسم المستخدم End If Next i lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock quantity = wsStock.Cells(j, "D").Value If wsStock.Cells(j, "A").Value = fromStore Then wsStock.Cells(j, "D").Value = newQuantity + fromStore1 ElseIf wsStock.Cells(j, "A").Value = toStore Then wsStock.Cells(j, "D").Value = toStore2 - newQuantity ' تم التعديل هنا wsStock.Cells(j, "J").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "K").Value = Environ("Username") ' اسم المستخدم End If Next j MsgBox "تم تعديل الفاتورة وإرجاع الكميات بنجاح" End Sub  
امين مخزن4.xlsm

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

تم حل المشكلة بواسطة منتدى اخر وذلك لانشغال بعض الاخوة فى الرد على الموضوع كان الله فى عونهما واحببت ان ارفق الملف للاستفادة
NEW EMPLOYEE TIME SHEET testing123.xls

الملف غير كامل
لايوجد فية Sheet7
form1.Hide
Sheet7.Range("R4").Value = Application.WorksheetFunction.VLookup(rngUser.Offset(0, -1).Value, Sheet1.Range("d2:d100"), 1, False)
Sheet7.Range("E4").Value = Date
Sheet7.Range("I4").Value = Application.WorksheetFunction.Text(Sheet7.Range("I4").Value, "dddd")
Sheet7.Range("M4").Value = Time
form2.Show
End If
 

On Error Resume Next Dim X As Worksheet Dim k As Integer Dim m As Date Dim n As Date ListBox1.Clear rng1 = CDate(TextBox9.Value) rng2 = CDate(TextBox10.Value) rng3 = ComboBox1.Text rng4 = ComboBox2.Text dfr = 0 For Each X In ThisWorkbook.Worksheets ss = X.Cells(Rows.Count, 2).End(xlUp).Row For i = 2 To ss If X.Cells(i, 6) Like "*" & rng3 & "*" And X.Cells(i, 4) Like "*" & rng4 & "*" And X.Cells(i, 2) >= rng1 And X.Cells(i, 2) <= rng2 Then ListBox1.AddItem ListBox1.List(dfr, 0) = X.Cells(i, 1) ListBox1.List(dfr, 1) = Format(X.Cells(i, 2), "dd/mm/yyyy") ListBox1.List(dfr, 2) = X.Cells(i, 3) ListBox1.List(dfr, 3) = X.Cells(i, 4) ListBox1.List(dfr, 4) = X.Cells(i, 5) ListBox1.List(dfr, 5) = X.Cells(i, 6) ListBox1.List(dfr, 6) = X.Cells(i, 7) ListBox1.List(dfr, 7) = X.Cells(i, 8) ListBox1.List(dfr, 8) = X.Cells(i, 9) ListBox1.List(dfr, 9) = X.Cells(i, 10) ListBox1.List(dfr, 10) = X.Cells(i, 11) '.Value ListBox1.List(dfr, 11) = X.Cells(i, 12) '.Value dfr = dfr + 1 End If Next i Next X Call Main Call Sort  
شكرا جزيلا  ا/ محمد هشام لقد تم الحل ونسيت ان ارفقه