mahmoud nasr alhasany

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

Private Sub CommandButton1_Click() Dim n If CB_Pièce = "Code article" Then MsgBox "Veuillez choisir un Code article.", 64, "Article requis": CB_Pièce.SetFocus: Exit Sub End If If Val(TextBox81) = 0 Then MsgBox "Stock provenance vide => retrait impossible !": Exit Sub If ComboBox2 = "" Then MsgBox "Veuillez choisir un Magasin de destination.": Exit Sub Dim T$, Qté&, chn$, b As Byte: T = "Contrôle Quantité" chn = TextBox82: If chn = "" Then MsgBox "Veuillez saisir une Quantité.", 64, T: Quantitetr.SetFocus: Exit Sub chn = Replace$(chn, ",", "."): If InStr(chn, ".") > 0 Then b = 1 'ni « , » ni « . » car Qté : nombre entier ! Qté = Val(chn): If Qté = 0 Then b = 1 'si chn est du texte ou 0, alors Qté = 0 => refusé ! If b = 1 Then MsgBox "Veuillez entrer une quantité valide !", 64, T Quantitetr = "": Quantitetr.SetFocus: Exit Sub End If If Qté > Val(stocktr.Caption) Then MsgBox "Quantité supérieure au stock actuel !", 64, T Quantitetr = "": Quantitetr.SetFocus: Exit Sub End If If Val(seuil.Caption) > Val(stocktr.Caption) Then MsgBox "Impossible d'effectuer ce transfert !", 64, T Quantitetr = "": Quantitetr.SetFocus: Exit Sub End If 'si y'a pas eu d'écriture sur "Inventaire", on quitte cette sub SANS Call MajInventaire: If lgD = 0 Then Exit Sub 'appeler LigneTransfert Call LigneTransfert: If lgT = 0 Then UndoOpInv 'ci-dessus : si y'a pas eu d'écriture sur "Transfert", faut ANNULER 'l'opération qui a été faite sur "Inventaire", car une opération de 'transfert n'est PAS valable si on n'a pas pu l'écrire sur une des 'deux feuilles "Inventaire" ou "Transfert". Unload Me End Sub Private Sub MajInventaire() Dim QS&, n&, v With Worksheets("Inventaire") flgAdd = 0 n = UBound(TblInv): lgS = 0: lgD = 0 GetLig ComboBox1, n, lgS: If lgS = 0 Then Exit Sub GetLig ComboBox2, n, lgD: If lgD > 0 Then flgAdd = 1 If lgD = 0 Then flgAdd = 0: lgD = n + 3 If lgD = 65000 Then MsgBox "Le tableau en feuille Inventaire est plein !", 48 lgD = 0: Exit Sub 'on fait rien, et on sort de la sub ! End If End If Application.ScreenUpdating = 0: .Unprotect: QT = Val(Quantitetr) With .Cells(lgS, 11) ' était (lgS, 3) QS = .Value + QT: .Value = QS: stocktr = QS End With Application.EnableEvents = False .Activate ' active la feuille If flgAdd = 0 Then ' insère une ligne .Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove .Unprotect .Rows("5:5").Copy ' copie la ligne en dessous .Rows("4:4").PasteSpecial xlPasteFormats ' colle le format .Range("D5").Copy ' copie la cellule .Range("D4").Select ' sélectionne la cellule ActiveSheet.Paste ' colle (formule incluse) Application.EnableEvents = True lgD = 4 End If For v = 0 To ListBox1.ListCount - 1 With .Cells(lgD, 3) If flgAdd = 0 Then .Offset(, -2) = ListBox1.List(v, 3) 'Code article .Offset(, -1) = ListBox1.List(v, 4) 'Catégorie .Offset(, 2) = ListBox1.List(v, 5) 'Seuil d'alerte .Offset(, 3) = ListBox1.List(v, 6) 'Descriptif .Offset(, 4) = ListBox1.List(v, 7) 'Référence .Offset(, 5) = ListBox1.List(v, 8) 'Unité de mesure .Offset(, 6) = "Transfert" 'Observations .Offset(, 9) = ComboBox2 'Magasin QD = Val(.Value) + QT: .Value = QD 'Stock actuel Else .Offset(, 7) = .Offset(, 7) + Quantitetr ' End If lgT = lgT + 1 End With .Protect: Application.ScreenUpdating = -1 Next End With End Sub Private Sub LigneTransfert() Dim v 'remplir une ligne sur le tableau de la feuille "Transfert", 'mais s'il n'y a plus de ligne libre, on ne fait rien ! With Worksheets("Transfert") 'Lastrow = Range("a" & Rows.Count).End(xlUp).Row + 1 lgT = .Cells(Rows.Count, 1).End(3).Row + 1 For v = 0 To ListBox1.ListCount - 1 If lgT = 650000 Then MsgBox "Le tableau en feuille Transfert est plein !", 48 lgT = 0: Exit Sub 'on fait rien, et on sort de la sub ! End If Dim Stock1&, Stock2& Application.ScreenUpdating = 0: .Unprotect '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Stock2 = Val(stocktr): Stock1 = Stock2 + QT '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' With .Cells(lgT, 1) .Value = CB_Pièce 'Code article .Offset(, 1) = ListBox1.List(v, 2) 'Catégorie .Offset(, 2) = ListBox1.List(v, 3) 'Désignation .Offset(, 3) = ListBox1.List(v, 4) 'Référence ' .Offset(, 4) = ListBox1.List(v, 4) 'Stock actuel .Offset(, 5) = ListBox1.List(v, 6) 'Unité .Offset(, 6) = Date 'Date .Offset(, 7) = ComboBox1 'Provenance .Offset(, 8) = ComboBox2 'Destination .Offset(, 9) = QT '= ListBox1.List(v, 13) 'Quantité transférée '.Offset(, 10) = Stock2 'STOCK PR ' .Offset(, 11) = QD 'STOCK DES .Offset(, 12) = TextBox1 .Offset(, 13) = Format(Now, "mm/dd/yyyy hh:mm am/pm") lgT = lgT + 1 End With .Protect: Application.ScreenUpdating = -1 Next End With End Sub يوجد يوزرفورم Transfer1 نظرا لكثرة الاصناف اضفت listbox1 الى الفورم وعند ترحيل البيانات الى الليست بوكس يعمل بنجاح ولاكن عند ترحيلها الى ورقة العمل لايقوم بالحفظ يوجد خطاء ولا اعرف السبب تحويلات بين المخازن2.xlsm

شكرا جزيلا ا/ محمد هشام

Private Sub CB_Pièce_Change() ' On Error Resume Next ComboBox2.Clear: Quantitetr = "" catetr = "": Desitr = "": reftr = "": stocktr = "": unitr = "": seuil = "" With ComboBox1 .Clear If CB_Pièce = "Code article" Then .AddItem "Magasin": .ListIndex = 0: Exit Sub End If Dim i& 'For i = UBound(arrPart, 2) To LBound(arrPart, 2) Step -1 For i = 1 To UBound(TblInv) If TblInv(i, 1) = CB_Pièce Then .AddItem TblInv(i, 12) 'crée la liste magasin Provenance 'écrit les infos des 5 labels (seulement s'ils sont vides) If catetr = "" Then catetr = TblInv(i, 2) 'Catégorie If Desitr = "" Then Desitr = TblInv(i, 6) 'Désignation If reftr = "" Then reftr = TblInv(i, 7) 'Référence If stocktr = "" Then stocktr = TblInv(i, 4) 'Stock Provenance If unitr = "" Then unitr = TblInv(i, 8) 'Unité If seuil = "" Then seuil = TblInv(i, 5) 'seuil If Me.TextBox_Stock_Initial = "" Then Me.TextBox_Stock_Initial = TblInv(i, 3) ' stockinitial End If Next i .ListIndex = 0 End With End Sub السلام عليكم ورحمة الله وبركاتة هل يمكنكم المساعدة عند اختار كود الصنف E124 تتم العملية ولاكن عند اختيار كود الصنف فى الكمبوبوكس 127 يحدث خطاء فماالمشكلة رجاء المساعدة تحويلات بين المخازن2.xlsm

السلام عليكم ورحمه الله وبركاته هل يوجد فكرة تمكننى عند اختيار اسنم الصنف يظهر الكميه الموجوده لهذا المخزن المتصرف منه

السلام عليكم ورحمة الله وبركاتة الرجاء مساعدتى عند اختيار اسم المخزن المنصرف يظهر الكمية الموجوده فى هذا المخزن القى نظرة الصورة الموضحة من فضلكم برنامج مخازن امين المخزن(1).xlsm

السلام عليكم ورحمه الله وبركاته هل يوجد احد يساعدني فى هذا الموضوع

ThisWorkbook.Activate Dim old_name, new_name old_name = Me.ComboBox1.Value new_name = Me.TextBox1.Value fda = ww.CountIf(Sheet2.Range("b2:b2000"), old_name) If fda <= 0 Then: MsgBox " هذا الاسم غير موجود فى قاعدة البيانات الخاص بهذا الفاتورة رجاء ادخال مسلسل رقم 1 " _ , mhmd, "ali ": Exit Sub يوجد قائمة كومبوبوكس بها حركات على حسب نوع الفاتورة مثل صرف /شراء /بيع /مرتجع/ رصيد اول مدة/ وصادر وكل حركة فاتورة لها كود سريل مخصص على حسب نوع الفاتورة ولاكن فى قاعدة البيانات لايوجد حركة فاتورة صادر فعندما اريد ان ابتدى باول حركة يضيف سريال كود الحركة برقم ( 1 ) بعد الرسالة المستعلمة msgbox Copy of مسلسل فاتورة على حسب نوع الفاتورة.xlsm

عفوا اخى alliiia لعلى لم ابين او اوضح لك المطلوب جيدا الف شكر لك اخى alliiia هذا هو المطلوب

شكر على الاستجابة السريعة اخى alliiia ولاكن انا اقصد مبيعات اخر العميل قيمة ولو على سبيل المثال ان اسماء العملاء فى العمود a متكررة اريد اخر قيمة لهذا العميل Mahmoud كمثال يوجد له قيم متعددة 1520 , 2058 , 2772 , 3486 , 4200 Mahmoud اخر قيمة له 4200

السلام عليكم ورحمة الله وبركاتة أيمكنك أن تساعدونى عند تحديد اسم عميل معين في ComboBox1 إحضار القيمة الأخيرة للعميل المدرجة في الورقة إلى selse.xlsmtextbox1

نا بصدد شغال على يوميةمخازن و مبيعات مناديب موضحة به رصيد البضاعة المتبقية بالسيارة من اليوم السابق لكل مندوب وقيمة البضاعة المستلمة من المخازن لكل مندوب و رصيد المرتجعات لكل مندوب و رصيد البضاعة المباعة لكل مندوب ورصيد المتبقى بالسيارة وايضا اظهار قيمة الخصم التجارى و صافى قيمة بعد الخصم ارجو المساعده

صورة موضحه لهذا العمل

السلام عليكم ورحمة الله وبركاتة عندى برنامج فورم امين مخزن يوجد به حركات شراء وارتجاع اصناف من المورد الى المخزن الرئيسى ويوجد ايضا تحويلات بين المخازن او السيارات (المندوب ) اريد عند اختيار كود الصنف واسم المخزن او المندوب اظهار كمية المخزون التابع للمخزن الحركة فى التكست بوكس 6 برنامج مخازن امين المخزن.xlsm

نعم اخي يمكنى فعل ذالك ولاكن بعض موافقة مشرفي المنتدى

Dim x As Integer Dim sum, sum1 As Double With Me.ListBox1 For x = 1 To .ListCount - 1 On Error Resume Next .List(x, 7) = Val(.List(x - 1, 7)) + Val(.List(x, 5)) - Val(.List(x, 6)) sum = sum1 + Val(.List(x, 5)) sum = sum1 + Val(.List(x, 6)) Next x .AddItem For C = 0 To 7 .List(.ListCount - 1, C) = "________________" Next C .AddItem "TOTAI" .List(.ListCount - 1, 5) = Format(sum, "fixed") .List(.ListCount - 1, 6) = Format(sum, "fixed") End With مرحباً هل يستطيع احد مساعدتي؟ أريد قائمة بإجمالي الرصيد الحالي في العمود الأخير، لكن لا أعرف ما المشكلة هناك 8 أعمدة في مربع القائمة. يرجى طرح قيمة العمود 6 من العمود ٧ وإظهار الناتج فى العمود ٨ وتكون النتيجة ترتيبا تصاعديا مثل (الخزينة) Classeur2 (1).xlsm

تسلم ايدك استاذ محمد هشام احسنت والله

اذا الفكره الذى اريدها هل تكون شبه مستحيله لأن مرجعية الجمع والطرح مبنيه على نوع الحركه فى العمود الثانى مع الطرح والجمع الكميه تكون فى العمود ٦ ليكون تسلسل الناتج فى العمود ٧

الملف غير كامل لايوجد فية 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

صباح الخير يوجد مسائله أخرى اريد طرحها إنها عملية معقدة هي عملية الجمع والطرح من القائمة، ولكن بشروط ومعايير محددة. وفي العمود السادس من مربع القائمة نجد كميات مختلفة حسب نوع الحركة شراء أو بيع في العمود الثاني. ما عليك فعله هو جمع وطرح الكميات حسب العمود الثاني ووضعها في العمود الأخير المميز باللون الأحمر. وعمليات الطرح هي (المبيعات) وعمليات الجمع هي (المشتريات). /مرتجعات المبيعات/مرتجعات الشراء) يجب أن تكون عملية الطرح والجمع عملية تدريجية هل عبرت عن وجهة نظري بوضوح؟ من فضلكم ساعدوني sum-listbox1.xlsm

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 شكرا جزيلا ا/ محمد هشام لقد تم الحل ونسيت ان ارفقه

On Error Resume Next If TextBox8.Value = "" Then ListBox1.Clear: Exit Sub Dim X As Worksheet Dim c As Range Dim k As Integer Dim m As Date Dim n As Date ListBox1.Clear k = 0 m = CDate(TextBox9.Value) n = CDate(TextBox10.Value) For Each X In ThisWorkbook.Worksheets ss = X.Cells(Rows.Count, 2).End(xlUp).Row For Each c In X.Range("B2:B" & ss) If (c.Value Like "*" & ComboBox1.Value & "*" Or c.Value Like "*" & ComboBox2.Value & "*") And (c.Offset(0, 2).Value >= m And c.Offset(0, 2).Value <= n) Then ListBox1.AddItem ListBox1.List(k, 0) = X.Cells(c.Row, 1).Value ListBox1.List(k, 1) = CDate(X.Cells(c.Row, 2).Value) ListBox1.List(k, 2) = X.Cells(c.Row, 3).Value ListBox1.List(k, 3) = X.Cells(c.Row, 4).Value ListBox1.List(k, 4) = X.Cells(c.Row, 5).Value ListBox1.List(k, 5) = X.Cells(c.Row, 6).Value ListBox1.List(k, 6) = X.Cells(c.Row, 7).Value ListBox1.List(k, 7) = X.Cells(c.Row, 8).Value ListBox1.List(k, 8) = X.Cells(c.Row, 9).Value ListBox1.List(k, 9) = X.Cells(c.Row, 10).Value k = k + 1 End If Next c Next X

مساء الخير أنا أعمل على نموذج المستخدم. إنها عملية بحث تعتمد على عدة معايير. هناك مربعي نص (التاريخ) وصندوقي قائمة (العميل - رمز المنتج)، ولكن هذا يعتمد على البحث عن أوراق عمل متعددة واسترجاعها من مربع القائمة. هل يوجد كود بحث مثل هذا؟ يرجى عرض جميع علامات الاختيار في الأعمدة الصفراء لمربع القائمة بناءً على خيارات مربع التحرير والسرد ومربع النص (التاريخ) البحث فى كل اوراق العمل1.xlsb