نجوم المشاركات

تم التعديل على اساس ان الحسابات الرئيسية الاربعة موجودة فعلا في الجدول ، وان العمليات المستقبلية تندرج تحتها من التوجيهات : لا يصلح ادراج رموز في تسميات الحقول سوى الفاصلة تحت السطر ( _ ) ( الاقواس وعلامة الزائد والناقص وعلامتي القسمة والفاصلة او الفاصلة المنقوطة كلها ممنوعة) ابتعد بل انسى الاستعانة بحقول داخل النموذج .. واخص بذلك الحقول غير المنضمة ففي عملك اعلاه استعنت بهذه الحقول كوسيط بين الكود في المحرر وبين الجدول للتأكد من الشرط .. والصحيح ان يأخذ الكود المعلومة او البيانات من الجدول مباشرة . من ضمن التعديلات اضافة جدولين لنوع الحساب وطبيعته ، وحيث انك في بداية مشروعك يجب ان تتعامل مع الارقام بدلا من النصوص خاصة اذا كانت النصوص بحروف عربية هذالتعديل او اتباع هذا النهج ستقطف ثمراته عندما تتعمق في مشروعك . بقي مسألة الأخطاء وتتبعها ومعالجتها داخل الحدث وهذه حقيقة مهمة جدا للمبرمج ان يفهمها ولكنها تحتاج الى درس متكامل وان شاء الله سوف افرد لها موضوعا خاصا اطرح فيه هذا الدرس dlookup7.rar

او جرب هدا ربما هدا ما تقصده Private Sub CommandButton1_Click() Dim WS As Worksheet, NewWb As Workbook Dim Path As Variant Set WS = Worksheets("Sheet18") If WS.[E2] = 0 Then: Exit Sub 'Path = "D:\test\" في حالة كان المسار ثابت يمكنك تعديل السطر التالي بما يناسبك ' ' اختيار مسار الحفظ Path = Application.GetSaveAsFilename(InitialFileName:=WS.[E2], _ fileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="الرجاء اختيار مكان الحفظ") If Path <> False Then Application.DisplayAlerts = False Application.ScreenUpdating = Fals WS.Copy Set NewWb = ActiveWorkbook With NewWb.Sheets(1).UsedRange .Value = .Value End With NewWb.SaveAs Path, FileFormat:=51 '**************************************************************** ' هدا للمسار الثايت ' NewWb.SaveAs Filename:=Path & WS.[E2] & ".xlsx", FileFormat:=51 '********************************************************************* NewWb.Close Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "Saved successfully" Unload Me End If End Sub SAV 18 v2.xlsb

تفضل اخي جرب هدا بعد إلغاء ارتباط Combobox (PREPARATEURS) من اعدادات اليوزرفورم كما في الملف المرفق Private Sub UserForm_Initialize() Set f = Sheets("PREPARATEUR ") Set d = CreateObject("Scripting.Dictionary") a = f.Range("A2:A" & f.[A65000].End(xlUp).Row) For i = LBound(a) To UBound(a) If a(i, 1) <> "" Then d(a(i, 1)) = "" Next i Me.PREPARATEURS.List = d.keys Me.DATES.Value = Date Me.HEURS.Value = Format(Now, "hh:mm:ss") End Sub '***************************** Private Sub AJOUTER_Click() Dim tbl As ListObject Dim arr, lr As Long, lige As Range, cmb() Set tbl = Range("LISTE_DE_BL").ListObject arr = Array(DATES.Value, HEURS.Value, _ Me.BLS.Value, Me.PREPARATEURS.Value) Set lige = tbl.ListColumns(1).Range.Find(What:="*", _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious) lige.Offset(1).Resize(1, 4).Value = arr Me.BLS = "": Me.PREPARATEURS = "" ThisWorkbook.Save UserForm_Initialize End Sub احتمالات واردة If Me.BLS.Value = "" Then: MsgBox "Please Enter N°BL", vbCritical: BLS.SetFocus: Exit Sub If Me.PREPARATEURS.Value = "" Then _ MsgBox "Please Enter a Name PREPARATEURS", vbCritical: PREPARATEURS.SetFocus: Exit Sub 'حقل اليوم و الوقت غير قابلة للتغيير Me.DATES.Locked = True Me.HEURS.Locked = True VBA V2.xlsm

تسلم جزاكم الله خيرا

السلام عليكم و رحمة الله و بركاتة الاخوة الكرام اعضاء المنتدى اقدم لكم برنامج بسيط من تنفيذى لادخال فواتير المبيعات و ترحيل البيانات الاساسية للفاتورة فى شيت و بيانات الاصناف فى شيت اخر يمكن ترحيل اكثر من صنف فى الفاتورة مع تكرار البيانات الاساسية فى شيت الاصناف اتمنى ان يستفيد الاخوة من البرنامج ملحوظة شيت Invoice محمى باسورد (1234) vba Invoice.xlsm