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

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

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

في الاساس برنامج نقطة بيع الذي عملته لمبيعات التجزئة لمتاجر وانشطة صغيرة ندخل في الموضوع اغلب الاصناف يتم توريدها بالكرتون ويتم ترميزها برمز الكرتون لمبيعات كرتون وترمز بالعلبة للبيع المفرد وهو الاكثر مبيعا الترميز فقط للاصناف الجديدة التي لم يسبق ترميزها الاصناف بالكرتون عند بيعها بالكرتون لا توجد هنا اي مشكلة اما اذا اردنا ان نفتح كرتون لبيع مفرد او تلف لبعض العبوات في الكرتون او تلف التغليف الخارجي للكرتون فلدينا شاشة تفريد الاصناف يتم فيها اختيار الصنف ( الكرتون ) والصنف المفرد ثم النقر على امر تفريد فيتم زيادة كمية الصنف علبه او وحدة بعدد العلب الموجودة في الكرتون اي ان اضافة الاصناف المفردة تكون لدينا من خلال فاتورة المشتريات مباشرة او من خلال شاشة تفريد صنف اما الصنف كرتون فيكون فقط من شاشة فاتورة مشتريات اي صنف يتم تفريدة يتم نقل تكاليفة الى صنف مفرد وتنقص كميتة من رمز كرتون مثلا لدينا 10 كراتين ماء صفا 200 مل تم تفريد كرتون واحد يكون المتبقي 9 كراتين وفي خانة ملاحظات كرتون 1 تم التفريد وتزيد كمية علبة ماء صفا بمقدار 48 علبة على العموم البرنامج في مرحلة التجربة في بيئة عمل فعلية وهناك العديد من الملاحظات التي لم يتسع وقتي لمعالجتها بسبب الاوضاع الحالية والمزاج الغير مواتي وتقبل اطيب تحياتي

جرب هذا الماكرو Option Explicit Sub salim_code() Dim s As Worksheet Dim La%, I%, Ro1, Ro2 Dim F_rg As Range, Source_rg As Range Dim My_number Set s = Sheets("Sheet1") La = s.Cells(Rows.Count, 2).End(3).Row Set Source_rg = s.Range("B4:B" & La) Source_rg.Font.ColorIndex = vbBlack My_number = Abs(s.Range("F3")) For I = 5 To La If IsNumeric(Cells(I, 2)) Then _ s.Cells(I, 2) = Abs(s.Cells(I, 2)) Next For I = 4 To La If s.Cells(I, 2) = My_number Then s.Cells(I, 2) = -s.Cells(I, 2) s.Cells(I, 2).Font.ColorIndex = 3 End If Next I End Sub الملف مرفق Saerch_Please.xlsm

أهلا بك @ابو البشر بالنسبة للرقم (1): المنهج GetRows يعيد عدد من صفوف بيانات الجدول المشار إليه في المتغير الغرضي XLRS. والرقم بين القوسين يبين عدد الصفوف المطلوب إعادتها.. المنهج GetRows يعيد مصفوفة بيانات من حدين؛ الحد الأول يمثل رقم عمود البيانات (الحقل) في الجدول والثاني يمثل رقم الصف البيانات (السجل).. هذه الحدود يبدأ ترقيمها بالرقم 0 يجب اسناد المنهج GetRows إلى متغير مصفوفة بيانات عامة غير معينة الحدود.. وهو هنا RCROW؛ وهو المشار إليه بالرقم (2). وكمثال (0,0)RCROW يعيد قيمة العمود الأول من الصف الأول في جدول البيانات. بالنسبة للرقم (3) :عند تجهال أسماء أعمدة البيانات المستوردة من أكسل يقوم أكسس بوضع أسماء مزيفة تبدأ بـ (F1)؛ و (F) اختصار كلمة Field و(1) رقم عمود البيانات في أكسس.. إذا كانت ورقة البيانات في أكسل تحتوي على أسماء للأعمدة فيمكن تغيير ذلك من خصائص استيراد البيانات؛ إما على مستوى مصنف البيانات أو على مستوى ورقة بيانات محددة... بالنسبة للرقم (4): يمكن الاستغناء عن المحدد، أو توسيع نطاقه.. لكن لا يمكن استخدام نطاقات متعددة في المجال الواحد.. أرجو أن يكون هذا التفسير واضحاً ومفهوماً ..

الحل الاتصال بمبرمج القاعدة للحصول على كلمة المرور

تسلم عينيك اخي احمد نحن مديونون لك هههههه خلك شاهد لو مادفع اخي ازهر 😃

جزاك الله حيرا أستاذنا خالد فكرة جميلة جدا تستحق ان توضع بعين الاعتبار فعد انتهاء الكمية من الصنف المفرد خارج الكرتونة يتم تنبيه البائع أنه يجب فتح كرتونة جديدة مثلا وبالامكان اجراء عملية التفريد بشكل آلي عند نفاد الكمية من الصنف المفرد - جميل جدا ولكن السؤال ما الرابط بين الصنف المسمي كرتونة والصنف الذي بداخل الكرتونة وقد جعلنا كلا منهما صنفا مستقلا. وفي النهاية أسأل الله أن يتقبل طاعتكم وان لا يعكر صفو مزاجكم وأن يرفع عنا البلاء والوباء انه علي كل شئ قدير

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

هذة الصور من نسخة البيتا وليست النهائية ونعم في النسخة النهائية توجد عبارة دفع جزئي ولكن للاسف هذا المشروع معطل لوجود خلاف مع المستفيد من البرنامج ولم يتم حل الخلاف 😭

من الامور التي اراها مهمة في اي برنامج اقساط ان يكون لدينا حقل للمبلغ المدفوع مثل لو لم يتم العميل من دفع كامل قيمة القسط وبالتالي يستطيع دفع اي مبلغ ويظهر لدينا المبلغ المتبقي من قيمة القسط شاهد القسط رقم 4

السلام عليكم جزا الله أستاذنا @أحمد الفلاحجى عنا خيرا ولكن ما أحببت أن أخلف وعدي فهذا ما توصلت اليه لعلها تكون طريقة اخري تصلح لمبتدئ مثلي Prog3.rar

الكود الذي اعطيتك ، والذي اعطاك ابو تراب ، يفتح البرنامج الآخر ولا ينتظر ان يُنهي البرنامج عمله ، وينتقل الطود للسطر التالي ، ولكن وفي بعض الاوقات ، تريد ان تفتح برنامج (او بمعنى اصح ، تريد ان تفتح برنامج ، وتكون قد ارسلت اليه المتغيرات المطلوبة مثل عمل QR Code مثلا) ، وتريد VBE ينتظر انتهاء البرنامج من عمله ، لهذا السبب نستعمل كود مثل Shell_n_Wait : https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas بنفس طريقة استعمال Shell او ExecuteFile اللي عرضه اخي ابو تراب ، شوف سطر عمله : جعفر

هلا اخي وهذه طريقة اخرى...استدعي الدالة ExecuteFile مصدر الكود من الموقع MS Access VBA – Open a File Option Compare Database Option Explicit 'Source: http://www.pacificdb.com.au/MVP/Code/ExeFile.htm Public Const SW_HIDE = 0 Public Const SW_MINIMIZE = 6 Public Const SW_RESTORE = 9 Public Const SW_SHOW = 5 Public Const SW_SHOWMAXIMIZED = 3 Public Const SW_SHOWMINIMIZED = 2 Public Const SW_SHOWMINNOACTIVE = 7 Public Const SW_SHOWNA = 8 Public Const SW_SHOWNOACTIVATE = 4 Public Const SW_SHOWNORMAL = 1 Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ ByVal lpParameters As String, ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long Public Sub ExecuteFile(sFileName As String, Optional ByVal sAction As String = "Open") Dim vReturn As Long 'sAction can be either "Open" or "Print". If ShellExecute(Access.hWndAccessApp, sAction, sFileName, vbNullString, "", SW_SHOWNORMAL) < 33 Then DoCmd.Beep MsgBox "File not found." End If End Sub

وعليكم السلام 🙂 اذا كان strFile هو اسم الملف + مساره ، فتستطيع فتحه هكذا: application.followhyperlink strFile جعفر

لأنك ارفقت ملف وورد .. لا يمكن العمل على الملف أاضف هذا الكود الى النطاق الذي تريد وضعت لك زرين . الاول لحجم الخط و الثاني لششكل التاريخ حسب طلبك يمكنك وضعهم في زر واحد . او اضافتهم الى كودك. فقط حتى تفهم الكود بالنسبة لعرض العمود هدا الكود Columns("A:B").Select Selection.EntireColumn.AutoFit للاحتواء التلقائي لمضمون النطاق أو Sub Column_Width() Columns("D:E").ColumnWidth = 10 End Sub ضع العرض كما تشاء font -date format.xlsm

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

السلام عليكم اخى @حربي العنزي مشاركه مع اخى واستاذى العزيز @أبو عبدالله الحلوانى جزاه الله خيرا لعل هذا ما تريد جرب ووافنا بالنتيجه بالتوفيق اخى Prog3.mdb

وعليكم السلام اخى واستاذى العزيز @أبو عبدالله الحلوانى كل عام وانت بخير منور الموقع مشاركه مع اخى الفاضل @ابو تراب جزاه الله خيرا لعل هذا الشرح يفيدك ايضا جزاه الله خيرا استاذ محمد فؤاد http://arabteam2000-forum.com/index.php?/topic/125583-كيف-تبني-برنامج-مخازن-ومبيعات-بطريقة-صحيحة-؟؟/ تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق

السلام عليكم 🙂 اللغة العربية هي المطلوبة هنا 🙂 المرفق المضغوط فيه مجلد وبرنامج اكسس ، والبرنامج اللي يعمل لنا QR code الموجود على الرابط التالي: https://sourceforge.net/projects/zint/ ويتم حفظ الصورة هنا Data > QR_images وعلشان كل شيء يشتغل تمام ، رجاء لا تعمل تغيير في مكان الملفات ولا المجلدات ، ولا تغيير اسمائها (طبعا تقدر تعمل اللي تريد ، بس على اساسه يجب تغيير الكود كذلك) وهي النتيجة: وخلونا نشوف من يقدر يقرأ الصورة 🙂 ----------------------------------------------------------------------------- إضافة في يوم الثلاثاء 7 / 5 / 2019 : عملت مثال يعمل على 2003 🙂 ----------------------------------------------------------------------------- إضافة في يوم الجمعة 14 / 6 / 2019 : باركود بطاقة دخول الطائرة (Boarding card) وهي من نوع PDF417 اختار الحقول اللي تريدها تظهر في QR code بإختيار مربع صح/خطأ : . والنتيجة: . و باركود 128 (ويمكن عمل اي نوع من انواع الباركود) . والتقرير (وبعد اذن اخي محمد سلامه ، فقد استعملت الصورة التي استعملها في مثاله 🙂 ) . وبهذه الطريقة نرى اننا لا نحتاج ان نحفظ صورة لكل سجل (واذا اردنا ذلك ، فنعمل تعديل في الكود ليقوم بذلك). وهذا الكود مضافا اليه عمل الباركود العادي : Private Sub Make_QR_Barcode() ' 'https://sourceforge.net/projects/zint/ ' If Len(Me.str_Text & "") = 0 Then Exit Sub Dim App_Name As String Dim Output_File As String Dim Output_Text As String Dim Encoding As String Dim Command_Line As String App_Name = Chr(34) & Application.CurrentProject.Path & "\Data\zint.exe" & Chr(34) Output_Text = Chr(34) & Me.str_Text & Chr(34) 'QR code Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "QR_code.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 --eci=24 --scale=2 -w 10 --height=100 --barcode=58 -d " & Output_Text 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide 'Barcode 128 Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "Barcode.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 -d " & Me.ID 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide 'PDF 417 Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "PDF_417.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 --eci=24 --binary --barcode=55 --mode=3 -d " & Output_Text 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide End Sub ----------------------------------------------------------------------------- إضافة في يوم الجمعة 22 / 6 / 2019 : تم عمل VCard QR ليخزن معلومات الشخص مباشرة في الموبايل 🙂 . وبإستخدام برامج الموبايل والتي تقرأ QR Code ، يمكنك حفظ معلومات VCard QR مباشرة في عناوين الموبايل 🙂 البرنامج zint الموجود في المرفق ، فيه امكانية عمل عدة انواع من QR والباركودات ، ولكن كل نوع من هذه الانواع له صيغة خاصة في عمله ، فمثلا كود VCArd QR هو: Function Add_Items() Dim VCard_Text As String 'clear field VCard_Text = "" VCard_Text = "BEGIN:VCARD" & vbCrLf VCard_Text = VCard_Text & "VERSION:3.0" & vbCrLf VCard_Text = VCard_Text & "N:" & Me.[Family Name] & ";" & Me.[Given Name] & ";" & Me.[Additional Name] & ";" & Me.[Name Prefix] & ";" & vbCrLf VCard_Text = VCard_Text & "FN:" & Me![Name] & vbCrLf VCard_Text = VCard_Text & "ORG:" & Me.[Organization 1] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 1 - Type] & ",VOICE:" & Me.[Phone 1 - Value] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 2 - Type] & ",VOICE:" & Me.[Phone 2 - Value] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 3 - Type] & ",VOICE:" & Me.[Phone 3 - Value] & vbCrLf VCard_Text = VCard_Text & "ADR;:" & ";;" & Me.[Address 1] & ";;;;" & vbCrLf VCard_Text = VCard_Text & "BDAY:" & Me.[Birthday] & vbCrLf VCard_Text = VCard_Text & "EMAIL;TYPE=" & Me.[E-mail 1 - Type] & ":" & Me.[E-mail 1 - Value] & vbCrLf VCard_Text = VCard_Text & "EMAIL;TYPE=" & Me.[E-mail 2 - Type] & ":" & Me.[E-mail 2 - Value] & vbCrLf VCard_Text = VCard_Text & "NOTE:" & Me.Notes & vbCrLf VCard_Text = VCard_Text & "URL:" & Me.[Website 1] & vbCrLf VCard_Text = VCard_Text & "END:VCARD" Add_Items = VCard_Text End Function والذي يختلف عن PDF417 والذي يختلف عن غيره. المرفق في ملفين بصيغة txt والذي فيهما جميع الاوامر التي يمكن استعمالها لعمل مختلف انواع الباركود 🙂 ----------------------------------------------------------------------------- إضافة في يوم السبت 2 / 11 / 2019 : هنا مثال لعمل بطاقة عمل ID.zip ، بأصغر حجم QR code (رجاء ابقاء حجمه ، فقد توصلت الى هذا الحجم والكود بعد محاولات ساعات طويلة) : . وهذا هو QR code . اما تفاصيل عمل البطاقات ، فهذا الرابط فيه تفاصيل كاملة: . جعفر ملاحظة: 1. المرفق في هذه المشاركة هو البرنامج الاخير ، وفيه جميع التعديلات التي في بقية المشاركات. 2. الـ api التي تنتظر إنتهاء الامر ، ثم تنتقل للسطر التالي في الكود اسمها ShellWait ، هذه لا تتعامل مع Unicode / utf-8 / ومنها الحروف العربية بطريقة صحيحة : http://access.mvps.org/access/api/api0004.htm بينما هذه تمام : https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas zint QR 3.zip ID.zip Shell_n_Wait_2021-12-13.txt.zip

وده شرح فيديو لعله يفيد بشئ

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

هدية مقبولة كرتون مناديل يحتوي على اربعة وحدات مغلفة كل مغلف يحتوي على 6 علب يمكن تفريد الكرتون مغلفات وبيعها هكذا او تفريدها علب ليكون عدد العلب 24 علبة او حتى تفريغ مغلف واحد ليكون لدينا 3 مغلفات وست علب والترميز امر سهل وفقا للصورة اعلاه

باذن الله استاذي محمد سلامة

تقبل الله منا ومنكم صالح الاعمال بخصوص الرابط مثل ماذكرت البرنامج لمشاريع صغير وهو مبادرة لتشجيع الانشطة الفردية ومجاني بضوابط محددة وبالتالي تفريد الاصناف يتم من خلال نموذج يحتوي على ثلاث حقول الصنف كرتون والصنف مفرد والكمية المرحلة من تفريغ الكرتون بخصوص فكرتك رسالة وتفريغ الى رائعة و يمكن عملها لو تحسن المزاج 😃 تحياتي وتقديري استاذ محمد 🌹

السلام عليكم ورحمة الله وبركاته ..... جميع اعضاء المنتدى ..... كل عام وانتم بخير وأسأل الله عز وجل أن يتقبل منا ومنكم صالح الاعمال استفسار حول كود سابق شارك في موضوعة في هذا الموضوع الأساتذة : @فايز و @Barna و @jjafferr و @أبو إبراهيم الغامدي في هذا الموضوع ولدي عدد من الاستفسار على الكود التالي بارك الله فيكم : Option Compare Database Option Explicit Sub IMPORT_XLSDB() On Error GoTo SUB_CLOSE '-- OPEN CURRENT DATABASE AS LOCAL DB Dim DB As DAO.Database Set DB = CurrentDb '-- OPEN RS DB TO ADD DATA Dim DBRS As DAO.Recordset Set DBRS = CurrentDb.OpenRecordset("TABLE") '-- OPEN XLS FILE AS REMOTE DATABASE Dim XLDB As DAO.Database Set XLDB = OpenDatabase( _ CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;") '-- OPEN XLS SHEET AS REMOTE RS Dim XLRS As DAO.Recordset Dim RCROW() Dim RC As Long Dim I As Integer Dim TD As DAO.TableDef '-- LOOP THROUGH XLDB TABLES (SHEETS) For Each TD In XLDB.TableDefs '-----------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (C) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing '--------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (I) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing Next SUB_CLOSE: '-- COLOSE XLDB AND XLRS Set XLRS = Nothing ' XLDB.Close Set XLDB = Nothing '------------------------' '-- CLOSE DB AND DBRS Set DBRS = Nothing XLDB.Close Set XLDB = Nothing End Sub 1- ما المقصود في الاؤقام المسجلة في 1 و 2 2- ما المقصود ب F1 و هل يمكن تغيير النطاق في 4 وكيف يتم ذلك لو اغترضنا أن ملف الاكسل نريد جلب بيانات اكثر من عامود في الصفحة الواحدة دون تكرار للكود كما فعلنا في الكود السابق بمعنى بجلب بيانات العمود C والعمود I مباشرة أو حتى أكثر من عمودين ؟؟؟؟ بارك الله فيكم وفي علمكم ... الموضوع هنا بارك الله فيكم

جزاك الله خيرا اخى حسام بالنسبه للدمغه وشروطها انظر للاستعلام تم اضافه التقريب لاخى حسام فالاستعلام - 50 كالاكسيل وتم تنفيذ الشروط كالاكسيل بعض الملاحظات ينصح بجعل كافه اسماء الحقول والجداول بالانجليزى ومن غير مسافات وان كان لابد من المسافه استبدلها _ بالشرطه السفليه وان جميع الحقول المحسوبه تجعلها بالاستعلامات بالتوفيق ابوحميد استفسار.accdb

تفضل . تم عمل المطلوب . انسخ المعادلات الى باقي الشيتات ضع اسم الصنف في الخلية a1 . انصحك باستعمال القائمة المنسدلة للاصناف بالنسبة للشرح ..... فليس هناك وقت وفير للشرح card-item.xlsx

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

جزاك الله خيرا اخى واستاذى العزيز @أبو عبدالله الحلوانى وعدت ووفيت واحسنت بارك الله فيك استاذى العزيز

اشكرك اخي خالد وبارك الله فيك هذا المطلوب

السلام عليكم هذه مشاركة مع استاذنا ابو تراب ملاحظة : الحل عن طريق معادلة اي لا حاجة للجدول Root210.rar

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

1. ادخل في صفحة VBE ، 2. . فتحصل على صفحة جديدة . 3. انسخ الكود من مشاركة اخي ابو تراب ، والصقه في الصفحة ، ثم احفظ الوحدة النمطية باسم مميز مثل mod_ExecuteFile : . 4. والآن من اي حدث ، نادي الوحدة النمطية هكذا : ExecuteFile "C:\Windows\System32\calc.exe" جعفر

جرب هذا. حساب555 تكاليف الشحن.XLSX

هذه احدى الافكار Private Sub Form_BeforeUpdate(Cancel As Integer) If MsgBox("Data has been changed, would you like to save", vbOKCancel) = vbCancel Then Cancel = True Me.Undo End If End Sub

اجعل تنسيق الخلايا هكذا [$-2000000]0

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

بعذ اذن الاخ ارائد هذا الملف My_saerch.xlsx

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا وكود جلب البيانات المتعدده لاستاذنا الغالى @jjafferr جزاه الله خيرا جزاك الله خيرا اخى حربى على دعائك ياطيب بالتوفيق اخى

الحقيقة كان تعديلي على مايكروا اضافة الاقساط بايقافة في حالة ان الاقساط مجدولة وبالتالي لا يعاد تكرارها مره اخرى وهو نفس التعديل في مرفق سابق للاستاذ ابو اشرف ومطابق لمرفقك في رأيي المتواضع ان الملف المرفق هو تعليمي لكيفية اضافة سجلات مجدولة عن طريق الاستعلام بدون استخدام اكواد vba اما في حال عمل برنامج للاستخدام في بيئة عمل حقيقة فان استخدام طرق اخرى اكثر جدوى وهي وجهة نظر شخصية 🌹 والشكر للاستاذ @أحمد الفلاحجى على تعديله

تعديل بسيط آخر جرب ووافنا بالنتيجه الاقساط.rar

ما شاء الله عليك .. كفيت ووفيت . .

هلا اخي هذا ليس اجابة عن سؤالك ولكم حبيت اشاركك تصميم مراقبة المخزون (متجر بيع بالتجزئة) Inventory Control (Retail Store) لعلى فيه بعض الافكار http://www.databaseanswers.org/data_models/inventory_control_for_retail/index.htm بالتوفيق

جرب هذا الملف الكود Option Explicit Sub From_sheet_to_Form() With Sheets("Salim") If .Range("N6") = vbNullString Then Exit Sub .[P8] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,2,0)") .[N8] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,3,0)") .[P10] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,4,0)") .[N10] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,5,0)") .[Q12] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,6,0)") .[O12] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,7,0)") .[M12] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,8,0)") End With End Sub '+++++++++++++++++++++++++++++++++++++++ Sub add_to_data_val() Dim arr(), m%, i%, lr% Dim s As Worksheet Set s = Sheets("Salim") lr = s.Cells(Rows.Count, 1).End(3).Row i = 2: m = 1 Do Until i = lr + 1 If Application.CountIf(s.Range("A2:A" & i), s.Range("A" & i)) = 1 Then ReDim Preserve arr(1 To m) arr(m) = s.Range("A" & i) m = m + 1 End If i = i + 1 Loop ReDim Preserve arr(1 To m) arr(m) = s.Range("N6") With s.Range("N6").Validation .Delete .Add 3, Formula1:=Join(arr, ",") End With s.Range("A" & lr + 1) = arr(UBound(arr)) s.Range("N6") = arr(UBound(arr)) End Sub '++++++++++++++++++++++++++++++++++++++++++++ Sub Form_To_sheet() Dim s As Worksheet Dim rg As Range, RO% Dim lr%, Answer As Byte Set s = Sheets("Salim") lr = s.Cells(Rows.Count, 1).End(3).Row If Application.CountIf(s.Range("A2:A" & lr), s.Range("N6")) = 0 Then Answer = MsgBox("This code dosn't exixts!.. " & Chr(10) & _ "Do you like to add it", 4) If Answer = 6 Then add_to_data_val Exit Sub End If End If Set rg = s.Range("A1:A" & lr).Find(s.[N6], lookat:=1) If rg Is Nothing Then Exit Sub RO = rg.Row With s .Range("A" & RO) = .[N6]: .Range("B" & RO) = .[P8] .Range("C" & RO) = .[N8]: .Range("D" & RO) = .[P10] .Range("E" & RO) = .[N10]: .Range("G" & RO) = .[Q12] .Range("H" & RO) = .[O12]: .Range("I" & RO) = .[M12] End With End Sub الملف مرفق Vice_versa.xlsm

السلام عليكم و رحمة الله و بركاته تفضل 1. تحقق من وجود mscomct2.ocx على جهازك ان وجدته ادهب مباشرة الى النقطة رقم 6 في أسفل االشرح ان لم تجده . 2- حمله من المرفقات الملف يعمل فقط لنسخ 32 بت للاكسل 2019-2016-2013 3- بالننسبة للونددوز 32-bit ضعه في هذا المسار C:\Windows\System32 بالننسبة للونددوز 64-bitضعه في هذا المسار C:\Windows\SysWoW64 4-الأن تسجيل الملف ادخل على قائمة إبدأ ثم Command Prompt و بالضغط على الزر الايمن اختر Run as Administrator. بالنسبة للوندوز 32 اكتب هذا الامر أو انسخه مباشرة C:\Windows\System32\regsvr32.exe mscomct2.ocx بالنسبة للوندوز 64 C:\Windows\SysWoW64\regsvr32.exe mscomct2.ocx 5-انسخ الامر و ضع المؤشر في Command Prompt ثم ااضغط الزر الايمن للفأرة . يلصق مباشرة ثم ENTER الان انتهيت من التسجيل 6-افتح اكسل ثم OPTIONS 7-الآن 8-ثم و بعد ذلك يمكنك ادرااجه من تبويب المطور أكرر فقط اوفيس 32 بت الصور من النت للأمانة و الحمد لله. MSCOMCT2.zip

من عيوني Test1.xlsx

بعد اذن أستاذ احمد تفضل اخي هذا بالكود بعد كتابة الارقام اضغط على ايقونة العدسة وسيتم جلب البيانات Sub EtaEng() Dim idnum As Variant, b As Object, i As Double Sheet2.Activate idnum = Left(Range("D7").Value, 4) Set b = Sheet1.Columns("b").Find(idnum, lookat:=xlPart, LookIn:=xlValues) If Not b Is Nothing Then 'exists i = b.Row Range("D10").Value = Sheet1.Cells(i, 3) Range("D12").Value = Sheet1.Cells(i, 2) Range("D14").Value = Sheet1.Cells(i, 4) Range("D16").Value = Sheet1.Cells(i, 5) Range("H10").Value = Sheet1.Cells(i, 6) Range("H12").Value = Sheet1.Cells(i, 7) Range("H14").Value = Sheet1.Cells(i, 8) Range("H16").Value = Sheet1.Cells(i, 9) Else MsgBox "هذا الرقم غير موجود", vbExclamation End If End Sub ملاحظة : يمكنك تغيير عدد الارقام كما تشاء من خلال هذا السطر وهو مصمم لاربعة ارقام ويجب ان تكتب الارقام من اليسار الى اليمين كما ترى idnum = Left(Range("D7").Value, 4) كشف_المحتاجين_2.xlsm

الأخ علي لا لزوم لهذه المعادلة الطويلة (لادراج من A الى Z ) تكفي هذه =IF(ROWS($A$1:A1)>26,"",CHAR(64+ROWS($A$1:A1))) ربما تنفع هذه الثلاث كودات Option Explicit Sub insert_arab() Dim i%, k% Dim arr() k = 0 Range("A1").CurrentRegion.ClearContents arr = Array(1, 2, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, _ 18, 19, 20, 21, 23, 24, 25, 27, 29, 30, 31, 32, 39) For i = LBound(arr) To UBound(arr) Range("A" & i + 1) = Chr(198 + arr(k)) k = k + 1 Next End Sub '++++++++++++++++++++++++++++++++++++ Sub insert_Cap() Range("C1").CurrentRegion.ClearContents Dim i% For i = 1 To 26 Range("C" & i) = Chr(64 + i) Next End Sub '++++++++++++++++++++++++++++++++++++++++++ Sub insert_Small() Range("F1").CurrentRegion.ClearContents Dim i% For i = 1 To 26 Range("F" & i) = Chr(96 + i) Next End Sub الملف مرفق ALPHABET.xlsm

فورم اكسل للبحث عن ايات القران الكريم وتفسيره ورقم الجذء والصفحة الفيديو فورم بحث عن ايات القران الكريم واجزائة.xlsm