mahmoud nasr alhasany

صباح الخير عليكم جميعا Private Sub rayon_vente_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'vente Dim i As Long, monproduit, lig As Integer If ctrl = True Then Exit Sub If Me.rayon_vente.ListIndex = -1 Then If [T_listrayon].Item(1, 1) = "" Then lig = 1 Else lig = [T_listrayon].Rows.Count + 1 [T_listrayon].Item(lig, 1) = Me.rayon_vente tbl = [T_listrayon].Value Tri tbl, LBound(tbl), UBound(tbl), 1 Me.Rayon.list = tbl Me.rayon_vente.list = tbl End If 'Me.produit_vente.Clear monproduit = [Produits].Value For i = 1 To UBound(monproduit) If monproduit(i, 2) = Me.rayon_vente Then Me.produit_vente.AddItem monproduit(i, 3) Me.produit_vente.list(Me.produit_vente.ListCount - 1, 1) = i Me.ComboBox4.AddItem monproduit(i, 11) Me.ComboBox4.list(Me.ComboBox4.ListCount - 1, 1) = i End If Next i ' Me.ComboBox4.Clear 'Me.prix_vente = "": Me.stock_vente = "": Me.TVAvente = "": Me.quantite_vente = "" End Sub عند تختار اسم الصنف من الكومبوبوكس يوجد فراغ فى القائمة المنسدلة فما سبب المشكلة Gest_magasin.xlsm

صباح الخير هذا الكود لايحدث المخزون بالقيمة الصحيحة فما الخطاء هنا Private Sub valid_vente_Click() 'valider vente On Error Resume Next Dim i As Integer, lig As Long, rep As Byte If Me.OptionButton1 = False And Me.OptionButton2 = False And Me.OptionButton3 = False Then rep = MsgBox("Vous n'avez oas choisi de moyen de paiement", vbCritical, "Contrôle") Exit Sub End If If Me.Total_vente = "" Then Exit Sub 'effacer facture Sheets("Facture").Range("F2:f6").ClearContents Sheets("Facture").Range("A11:E46").ClearContents Sheets("Facture").Range("B8,E8").ClearContents Sheets("Facture").Range("B8").Value = Year(Date) & "-" & Format(Sheets("Facture").Range("L1").Value + 1, "0000") Sheets("Facture").Range("L1").Value = Sheets("Facture").Range("L1").Value + 1 'N° Facture Sheets("Facture").Range("E8").Value = Date 'date Sheets("Facture").Range("F2").Value = Me.nom_vente.Value If Me.nom_vente <> "" Then Sheets("Facture").Range("F3").Value = [Client].Item(Me.nom_vente.Column(0), 3) Sheets("Facture").Range("F4").Value = [Client].Item(Me.nom_vente.Column(0), 4) Sheets("Facture").Range("F5").Value = [Client].Item(Me.nom_vente.Column(0), 5) Sheets("Facture").Range("F6").Value = [Client].Item(Me.nom_vente.Column(0), 6) End If For i = 0 To ListBox1.ListCount - 1 Sheets("Facture").Range("A" & 11 + i) = Me.ListBox1.List(i, 1) 'Rayon Sheets("Facture").Range("B" & 11 + i) = Me.ListBox1.List(i, 2) 'article Sheets("Facture").Range("E" & 11 + i) = Me.ListBox1.List(i, 4) 'tva Sheets("Facture").Range("D" & 11 + i) = Me.ListBox1.List(i, 6) 'prix de vente Sheets("Facture").Range("C" & 11 + i) = Me.ListBox1.List(i, 5) 'quantité Sheets("Facture").Range("G47") = CDbl(Me.Remise) 'mettre a jour mouvement et stock If [Mouvement].Item(1, 1) = "" Then lig = 1 Else lig = [Mouvement].Rows.Count + 1 [Mouvement].Item(lig, 1) = Me.ListBox1.List(i, 1) 'Rayon [Mouvement].Item(lig, 2) = Me.ListBox1.List(i, 2) 'article [Mouvement].Item(lig, 4) = Me.ListBox1.List(i, 5) 'quantite [Mouvement].Item(lig, 5) = Date [Mouvement].Item(lig, 7) = "Vente " & Me.nom_vente.Value ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' [Produits].Item(CLng(CInt(Me.ListBox1.List(i, 0))), 4) = [Produits].Item(CLng(CInt(Me.ListBox1.List(i, 6))), 4) - [Mouvement].Item(lig, 4) [Mouvement].Item(lig, 6) = [Produits].Item(CLng(Me.ListBox1.List(i, 0)), 4) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Next i If Me.OptionButton1 = True Then [Mouvement].Item(lig, 8) = Me.OptionButton1.Caption If Me.OptionButton2 = True Then [Mouvement].Item(lig, 8) = Me.OptionButton2.Caption If Me.OptionButton3 = True Then [Mouvement].Item(lig, 8) = Me.OptionButton3.Caption [Mouvement].Item(lig, 10) = ComboBox4 [Mouvement].Item(lig, 9) = CDbl(Me.Total_vente) Me.facture.Visible = True rep = MsgBox("Cliquez sur Facture, Nouveau ou Quitter", vbOKOnly, "Vente enregistrée.") End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'اريد اضيف خيار ثالث يشمل اسم المخزن ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' [Produits].Item(CLng(CInt(Me.ListBox1.List(i, 0))), 4) = [Produits].Item(CLng(CInt(Me.ListBox1.List(i, 6))), 4) - [Mouvement].Item(lig, 4) [Mouvement].Item(lig, 6) = [Produits].Item(CLng(Me.ListBox1.List(i, 0)), 4) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' مخزن.xlsm

On Error Resume Next Dim i As Integer, MyRow As Integer, ii As Integer, Abu_Ahmed As Boolean Dim Sh_A As Worksheet Dim AA As Integer On Error Resume Next Application.ScreenUpdating = False For i = 4 To Sheets("Stock").Range("A1000").End(xlUp).Row If ComboBox2 = Sheets("Stock").Cells(i, 12) And Val(CB_Pièce) = Sheets("Stock").Cells(i, 1) Then MyRow = Sheets("Stock").Cells(i, 1).Row Abu_Ahmed = True GoTo 1 Exit For End If Next 1 If Abu_Ahmed = True Then Else If MsgBox("هذا الصنف لايوجد فى قواعد البيانات فى" & Me.ComboBox2, vbYesNo) = vbYes Then If MsgBox("هل تريد المتابعة الى شاشة اضافة هذا الصنف الى المخزن", vbYesNo) = vbYes Then UserForm9.Show Else TextBox_Stock_Initial.Value = "0" MsgBox "هل تريد الالغاء" Exit Sub End If End If End If Application.ScreenUpdating = True تم اصلاح مشكلة الحدث

نعم انه بالفعل فى شيت stock ولاكن المشكله ان الرسالة تتكرر واضيف صور لذلك الرسالة الثانية لا اريدها ان تتكرر يتم الالغاء MsgBox("هذا الصنف لايوجد فى قواعد البيانات فى مخزن 5") عندما اعطى الامر لا يأتى هذا الامر MsgBox("هذا الصنف لايوجد فى قواعد البيانات فى")

Sub ADDD() On Error Resume Next Dim i As Integer, MyRow As Integer, ii As Integer, Abu_Ahmed As Boolean Dim Sh_A As Worksheet Dim AA As Integer On Error Resume Next Application.ScreenUpdating = False For i = 4 To Sheets("Stock").Range("A1000").End(xlUp).Row If ComboBox2 = Sheets("Stock").Cells(i, 12) And Val(CB_Pièce) = Sheets("Stock").Cells(i, 1) Then MyRow = Sheets("Stock").Cells(i, 1).Row Abu_Ahmed = True GoTo 1 Exit For End If Next 1 If Abu_Ahmed = True Then Else If MsgBox("هذا الصنف لايوجد فى قواعد البيانات فى " & Me.ComboBox2, vbYesNo + vbQuestion) = vbYes Then Else 'CB_Pièce = "" ComboBox2 = "" Exit Sub End If Hide 'Unload Me UserForm9.Show End If Application.ScreenUpdating = True End Sub كل سنة وانتم طيبين بمنااسبة الشهر الكريم اعاده عليكم باليمن والبركات يوجد سؤال ملحوظة لا يوجد هذا الصنف 100 فى مخزن 5 عند اختيار من مخزن الرئيسى الى مخزن 5 تأتى الرسالة بان MsgBox("هذا الصنف لايوجد فى قواعد البيانات فى " ولاكن عند اختيار الامر نعم تتكرر الرسالة مالخطاء فى هذا الامر f نقل المخزون بين المخازن 2026.xlsm

شكرا جزيلا لك ا/احمد عبدالحليم على هذا الكود ولك منا كل احترام وتقدير شكرا لك على هذا الاهتمام

لو افترضنا ان يوجد كمية 20 كرتونة فى المخزن الرئيسى للمنتج 1 ويتم تحويل 5 كرتونة ليكون رصيد المخزن الرئيسى (15) كرتونة اما المخزن 1 يوجد كمية 8 كرتونة للمنتج 1 وتم تحويل من المخزن الرئيسى 5 ليكون رصيد مخزن 1 (13) كرتونة الرجاء المساعدة

صباح الخير لقد قمت بتصميم برنامج مخازن فكرة هذا البرنامج هي نقل الكمية بين المخازن وقمت بتصدير البيانات إلى شيت Mvts ومع ذلك، لا يقوم بتحديث أو نقل كمية المخزون بين المخازن. في شيت stock هل من الممكن إنشاء كود ينقل الكمية بين المخازن ويقوم بتحديث المخزون نقل المخزون بين المخازن.xlsm

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

تم حل المشكلة بالنسبة للتاريخ اما بالنسبة مؤشر التنقلات( الاول -والتالى -السابق- الاخير) اريد ادراج الاكواد الخاص بها فى الفورم وذلك عند عملية البحث بتاريخ معين كمثال عند ادخال تاريخ فى txtEndDate 02/02/2023 يظهر 4 تواريخ بيانات فى الشيت ويأتى فى عملية البحث اظهار اول تاريخ من 4 بيانات لهذا التاريخ اريد التنقل وفقا لهذا التاريخ فقط واظهار العدد بين المؤشر التنقلات فى lblCod باللون الاحمر (0) Copy of NEW EMPLOYEE TIME SHEET testing.xls

السلام عليكم ورحمة الله وبركاتة الرجاء المساعدة عند الاستعلام بتاريخ معين لايقوم بجلب البيانات صحيحة ولاكن يجلب اخر بيانات فى الشيت نظرا لاخر كود مدرج فى البيانات NEW EMPLOYEE TIME SHEET testing.xls

Sub ImporterExcelPartirWord() 'Déclarez les variables Object pour l'application et le document Word. Dim WordApp As Object, wddoc As Object 'Déclarez une variable String pour le nom du document d'exemple et le chemin du dossier. Dim strDocNom As String 'L'instruction On Error si Word n'est pas déjà ouvert. On Error Resume Next 'Activer Word s'il est déjà ouvert. Set WordApp = GetObject(, "Word.Application") If Err.Number = 429 Then Err.Clear 'Créez une application Word si Word n'est pas déjà ouvert. Set WordApp = CreateObject("Word.Application") End If 'Assurez-vous que l'application Word est visible. WordApp.Visible = True 'Définissez la variable de chaîne strDocName. strDocNom = "C:\mesfichiers\monDocWord.docx" 'Activez l'application Word. WordApp.Activate 'Définissez la variable objet pour le nom complet du document Word et le chemin d'accès au dossier. Set worddoc = WordApp.Documents(strDocNom) 'Si le document Word n'est pas déjà ouvert, ouvrez-le. If worddoc Is Nothing Then Set worddoc = WordApp.Documents.Open(strDocNom) 'Le document est ouvert, alors activez-le. worddoc.Activate 'Copier le paragraphe 2 worddoc.Paragraphs(2).Range.Copy 'Activez votre classeur et collez le texte copié dans la cellule active. ThisWorkbook.Activate 'Collez le paragraphe 2 du document Word. ActiveSheet.Paste 'Fermez le document Word, pas besoin d'enregistrer les modifications. worddoc.Close Savechanges:=False 'Quittez l'application Word. WordApp.Quit 'Libérez la mémoire système réservée aux deux variables Object. Set worddoc = Nothing Set WordApp = Nothing End Sub

وعليكم السلام ورحمة الله بركاته انا كويس

السلام عليكم ورحمة الله وبركاتة

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

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 هذا هو المطلوب