بحث مخصص من جوجل فى أوفيسنا
Custom Search
|
-
Posts
197 -
تاريخ الانضمام
-
تاريخ اخر زياره
Community Answers
-
mahmoud nasr alhasany's post in توزيع فئة على حسب القيمة مبلغ 1 و مبلغ 2 was marked as the answer
Dim totalValue As Double Dim targetValue1 As Double Dim targetValue2 As Double ' Get values from TextBoxes totalValue = Val(TextBox10.Value) targetValue1 = Val(TextBox11.Value) targetValue2 = Val(TextBox12.Value) ' Check for feasibility If targetValue1 + targetValue2 <> totalValue Then MsgBox "Target values do not match total value.", vbCritical Exit Sub End If ' Initialize banknote counts Dim count200 As Integer: count200 = Val(TextBox1.Value) Dim count100 As Integer: count100 = Val(TextBox2.Value) Dim count50 As Integer: count50 = Val(TextBox3.Value) ' Create arrays to store distribution Dim group1(1 To 3) As Integer Dim group2(1 To 3) As Integer ' Random distribution loop Do ' Reset group values For i = 1 To 3 group1(i) = 0 group2(i) = 0 Next i ' Randomly assign 200 denomination banknotes Randomize For i = 1 To count200 If Rnd() < 0.5 Then group1(1) = group1(1) + 1 Else group2(1) = group2(1) + 1 End If Next ' Randomly assign 100 denomination banknotes Randomize For i = 1 To count100 If Rnd() < 0.5 Then group1(2) = group1(2) + 1 Else group2(2) = group2(2) + 1 End If Next ' Randomly assign 50 denomination banknotes Randomize For i = 1 To count50 If Rnd() < 0.5 Then group1(3) = group1(3) + 1 Else group2(3) = group2(3) + 1 End If Next ' Calculate the total value of each group Dim group1Total As Double: group1Total = group1(1) * 200 + group1(2) * 100 + group1(3) * 50 Dim group2Total As Double: group2Total = group2(1) * 200 + group2(2) * 100 + group2(3) * 50 Loop Until group1Total = targetValue1 And group2Total = targetValue2 ' Display the distribution in TextBoxes or other controls TextBox4.Value = group1(1) TextBox7.Value = group2(1) TextBox5.Value = group1(2) TextBox8.Value = group2(2) TextBox6.Value = group1(3) TextBox9.Value = group2(3) لقد وجدت الحل بحمدلله
-
mahmoud nasr alhasany's post in ترتيب البيانات من خلال Combobox1 , Checkbox1 was marked as the answer
وجدت الحل بحمدلله
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
-
mahmoud nasr alhasany's post in تحليل كود تحويل كمية اصناف بين المخازن was marked as the answer
' تحديث المخزون بناءً على الفرق في الكمية 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 تم تعديلة الى العكس السالب والموجب'
لتنجح الفكرة شكرا ا/محمد هشام على المجهود الرائع
-
mahmoud nasr alhasany's post in حذف فاتورة وارجاع كمية المخزون للمخزن المخصص لها was marked as the answer
تم ايجاد المشكلة بحمدلله الخاص بتعديل الكمية وارجاعها للمخزنين سواء خصم اوزيادة فى احداهما
يوجد كودين
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
-
mahmoud nasr alhasany's post in محتاج ادخال فاتورة عن طريق يوزر فورم was marked as the answer
فاتورة خبوريه
من اعمال السيد/ ضاحى غريب
والسيد / عبدلله باقشير
-
mahmoud nasr alhasany's post in بحث بتاريخ محدد was marked as the answer
تم حل المشكلة بواسطة منتدى اخر وذلك لانشغال بعض الاخوة فى الرد على الموضوع كان الله فى عونهما واحببت ان ارفق الملف للاستفادة
NEW EMPLOYEE TIME SHEET testing123.xls
-
mahmoud nasr alhasany's post in برنامج شاشة الدخول مع صلاحيات was marked as the answer
الملف غير كامل
لايوجد فية 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
-
mahmoud nasr alhasany's post in بحث في جميع اوراق العمل على اكثر من معيار was marked as the answer
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
شكرا جزيلا ا/ محمد هشام لقد تم الحل ونسيت ان ارفقه