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

السلام عليكم ورحمة الله اجعل المعادلة هكذا =MATCH(H2;INDIRECT(P2);0)

السلام عليكم ورحمة الله تعالى وبركاته ..تفضل اخي الكريم Private Sub CommandButton1_Click() Dim filePath As String Dim Ws As Worksheet Application.ScreenUpdating = False filePath = Application.ActiveWorkbook.Path Set Ws = Sheets("بيانات") With Ws .Copy Application.DisplayAlerts = False Application.CutCopyMode = False Dim shape As Excel.shape For Each shape In ActiveSheet.Shapes shape.Delete Next Application.ActiveWorkbook.SaveAs Filename:=filePath & "\" & .Name & "" & "" & ".xlsx", FileFormat:=51 Application.ActiveWorkbook.Close False End With MsgBox "تم نسخ الملف بنجاح" Application.ScreenUpdating = True End Sub wor_MH.xlsm

السلام عليكم ورحمة الله تعالى وبركاته بالنسبة للكود يمكنك جعله بهده الطريقة اخي الكريم وسبب تاخيري عن الرد على طلبك هو انني كنت انتظر جوابك بخصوص كود المنتج لاكن للاسف جوابك غير مفهوم (كود المنتج يكتب آليا ) تتضمن عدة امور Private Sub CommandButton10_Click() If Me.txt_product.Value = "" Then MsgBox "الرجاء ادخال اسم المنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_pru) = False Then MsgBox "الرجاءادخال سعر شراءالمنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_sale) = False Then MsgBox "الرجاء ادخال سعر البيع", vbCritical Exit Sub End If Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("product_master") If Application.WorksheetFunction.CountIf(sh.Range("b:b"), Me.txt_product.Value) > 0 Then MsgBox "هذا المنتج مضاف مسبقا", vbCritical Exit Sub End If With ActiveSheet If .FilterMode Then .ShowAllData lr = .Cells(Rows.Count, 1).End(3).Row + 1 Cells(lr, 1).Resize(, 4) = Array(lr - 1, txt_product, txt_price_sale, txt_price_pru) End With Me.txt_product.Value = "" Me.txt_price_sale.Value = "" Me.txt_price_pru.Value = "" MsgBox "Done", vbtnformation End Sub اما الزيادة التي سبق ان وعدتك بها في المشاركة السابقة هي عبارة عن ملفك يتضمن جميع الاظافات التي من الممكن ان تحتاجها . ترحيل _ تعديل _ حدف _ بحث بكود المنتج Private Sub CommandButton9_Click() '''''''''ترحيل البيانات''''''''' ''الشرط الاول'' If Me.txt_product.Value = "" Then MsgBox "الرجاء ادخال اسم المنتج", vbCritical Exit Sub End If ''الشرط الثاني'' If IsNumeric(Me.txt_price_pru) = False Then MsgBox "الرجاءادخال سعر شراءالمنتج", vbCritical Exit Sub End If ''الشرط الثالث'' If IsNumeric(Me.txt_price_sale) = False Then MsgBox "الرجاء ادخال سعر البيع", vbCritical Exit Sub End If ''التحقق من وجود اسم المنتج مسبقا '' Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("product_master") If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txt_product.Value) > 0 Then MsgBox "هذا المنتج مضاف مسبقا", vbCritical Exit Sub End If ''''''''''' النطاق المرحل اليه'''''''''''' Dim lr As Long lr = Sheets("product_master").Range("B" & Rows.Count).End(xlUp).Row With sh .Cells(lr + 1, "b").Value = Me.txt_product.Value .Cells(lr + 1, "c").Value = Me.txt_price_pru.Value .Cells(lr + 1, "d").Value = Me.txt_price_sale.Value End With ''''''''افراغ textbox''''''' Me.txtSearch.Value = "" Me.txt_product.Value = "" Me.txt_price_pru.Value = "" Me.txt_price_sale.Value = "" ''''''''(A)ترقيم تلقائي لعمود '''''' ''مع امكانية حدف الصفوف '' Worksheets("product_master").Activate Application.EnableEvents = False With Range("a2:a" & Cells.Find("*", , , , xlByRows, xlPrevious).Row) .Formula = "=Row() - 1" .Value = .Value End With Application.EnableEvents = True MsgBox "تم الترحيل بنجاح", vbtnformation '' UserForm_تحديث '' Unload Me frm_product_master.Show End Sub '''''''''' البحث بكود المنتج'''''''''''' Private Sub CommandButton10_Click() Dim x As Long Dim y As Long x = Sheets("product_master").Range("A" & Rows.Count).End(xlUp).Row If Me.txtSearch.Value = "" Then MsgBox "الرجاء ادخال كودالمنتج", vbCritical Exit Sub End If For y = 2 To x If Sheets("product_master").Cells(y, 1).Value = txtSearch.Text Then txt_product = Sheets("product_master").Cells(y, 2).Value txt_price_pru = Sheets("product_master").Cells(y, 3).Value txt_price_sale = Sheets("product_master").Cells(y, 4).Value End If Next y End Sub ''''''''''''''''تعديل البيانات'''''''''''''''' Private Sub CommandButton12_Click() Dim x As Long Dim y As Long x = Sheets("product_master").Range("A" & Rows.Count).End(xlUp).Row If Me.txt_product.Value = "" Then MsgBox "الرجاء ادخال اسم المنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_pru) = False Then MsgBox "الرجاءادخال سعر شراءالمنتج", vbCritical Exit Sub End If For y = 2 To x If Sheets("product_master").Cells(y, 1).Value = txtSearch.Text Then Sheets("product_master").Cells(y, 2).Value = txt_product Sheets("product_master").Cells(y, 3).Value = txt_price_pru Sheets("product_master").Cells(y, 4).Value = txt_price_sale End If Next y Me.txtSearch.Value = "" Me.txt_product.Value = "" Me.txt_price_pru.Value = "" Me.txt_price_sale.Value = "" MsgBox "تم التعديل بنجاح", vbInformation End Sub ''''''''''''''''حدف صف معين'''''''''''''''' Private Sub CommandButton13_Click() Dim x As Long Dim y As Long x = Sheets("product_master").Range("A" & Rows.Count).End(xlUp).Row If Me.txtSearch.Value = "" Then MsgBox "الرجاء ادخال كودالمنتج", vbCritical Exit Sub End If For y = 2 To x If Sheets("product_master").Cells(y, 1).Value = txtSearch.Text Then Rows(y).Delete End If Next y Me.txtSearch.Value = "" Me.txt_product.Value = "" Me.txt_price_pru.Value = "" Me.txt_price_sale.Value = "" MsgBox "تم حدف البيانات بنجاح", vbInformation Call MH Unload Me frm_product_master.Show End Sub ''''''''''''''''UserForm _ تحديث واجهة '''''''''''''''' Sub Refresh_data() Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("product_master") Dim lr As Long lr = Sheets("product_master").Range("a" & Rows.Count).End(xlUp).Row If lr = 1 Then lr = 2 With Me.ListBox .ColumnCount = 4 .ColumnHeads = True .RowSource = "product_master!A2:d" & lr End With End Sub Private Sub CommandButton14_Click() If MsgBox("هل تريد الخروج من البرنامج", vbQuestion + vbYesNo, "Confirmation") = vbYes Then Unload Me End If End Sub Private Sub ListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean) txtSearch.Text = ListBox.Column(0) If txtSearch.Text = Me.ListBox.Column(0) Then Me.txt_product = Me.ListBox.Column(1) Me.txt_price_pru = Me.ListBox.Column(2) Me.txt_price_sale = Me.ListBox.Column(3) End If End Sub المحل_MH.xlsm

اخي الداله غير موجودة في التقرير والتقارير تعتمد اساسا على استعلامات انا كتب لك اوامر الجمع في استعلام حسب الحساب في اوامر التقرير انت قم بتعديل البقية حسب كل شرط تريده T3Q - Copy(1).accdb

بعد اذن اخي عمر ضاحي ... الاساس عندك هو فاتورة الشراء او البيع ... والصنف هو جزء من تلك الفاتورة يمكنك ان تعمل كومبوبوكس للصنف في فاتورة الشراء او البيع وتجعل مصدر بياناتها هو الصنف ..او تجعل مصدر بيانات الصنف عبارة عن باركود

QR CODE.xlsm

يمكنك - أخي الكريم - تجربة هذا الملف دون إشارة - بين الكلمات وكما ترى في الصورة المرفقة تم اختبار المعادلة مع وجود - بين الكلمات QR CODE.xlsm

السلام عليكم أخي الكريم ..باستخدام المصنف ذاته لأنه يحتوي على أكواد تتعلق بالـ QR CODE يمكنك وضع المعادلة التالية للحصول على النتيجة المطلوبة (( والله أعلم)). =URL_QRCode_SERIES("qr_code_1";CONCATENATE(B2;"-";C2;"-";D2;IF(E2<>"";"-";"");E2;IF(F2<>"";"-";"");F2;"-";B4;"-";B5);;"qrCode") يمكنك التعديل عليها بما يناسب طلبك QR CODE.xlsm

وعليكم السلام ..قم أولاً بتحويل تنسيق الأرقام إلى رقم لأنها منسقة على شكل نص من V9:V15 أو اضرب قيمة كل خلية بـ 1 أما القيم الرقمية في العمود .AC9:AE15 استبدل كلمة دائن بفراغ وحوله إلى رقم ..أو استخدم المعادلة التالية: =SUBSTITUTE(AC9;"دائن";"") نموذج اوفيسنا.xlsx

أخي الكريم هل تقصد عند فتح ملف الاكسيل؟

لماذا تحتاج لتغيير هذه الأرقام مع دقة شاشة المستخدم هذه الأرقام تخص دقة الشاشة التي تم تصميم البرنامج عليها وتم ضبط حجم النموذج عليها بحيث إذا كانت دقة شاشة المستخدم مساوية لها لا يتغير شيء أما إذا كانت دقة شاشة المستخدم غير الدقة التي تم التصميم عليها يتم تغيير حجم النموذج وكل عناصره إلى ما يتناسب مع دقة شاشة المستخدم سواء بتكبير النموذج أو تصغيره