ابو جودي

هذا كلام لا غبار عليه لذلك عندما يسأل احد عن تعلم لغة برمجة حقيقية وبم يبدأ دائما اقول له #C

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

لسه والقادم اجمل ...ده لسه فيه ...... بلاش احرق لكم المفاجآت

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

فـ إيه بئه

اتفضل بسيطة غير للكود الاتى On Error GoTo Oops Dim db As dao.Database: Set db = CurrentDb() Dim rs As dao.Recordset: Set rs = db.OpenRecordset("file-1") Dim intSpID As Long: intSpID = 0 With rs .MoveFirst Do intSpID = intSpID + 1 rs.Edit rs![الرقم الحسابي] = 11 & intSpID rs.Update .MoveNext Loop Until .EOF .Close End With db.Close function_exit: Set rs = Nothing Set db = Nothing Exit Sub Oops: ' Handle the errors here GoTo function_exit

اتفضل قم بوضع هذا الكود فى حدث عند النقر على زر امر فى نموذج On Error GoTo Oops Dim db As dao.Database: Set db = CurrentDb() Dim rs As dao.Recordset: Set rs = db.OpenRecordset("file-1") Dim intSpID As Long: intSpID = 110 With rs .MoveFirst Do intSpID = intSpID + 1 rs.Edit rs![الرقم الحسابي] = intSpID rs.Update .MoveNext Loop Until .EOF .Close End With db.Close function_exit: Set rs = Nothing Set db = Nothing Exit Sub Oops: ' Handle the errors here GoTo function_exit

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

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

جرب المرفق ووافنى بالنتيجة GenerateOrReadQRCodeImageV.03.mdb.zip

- ممكن مرفق لو تكرمت

سوف تكون بهذا الشكل استبدل [DateEntered] بـ الدالة Format([DateEntered],"dd/mm/yyyy")

استخدم الكود الاتى Fix(100*[Field Name])/100 او ضع الكود الاتى فى موديول وهذا ما افضله لما فيه من مرونة Public Function SpltDta(ByVal FieldName As String, ByVal intNo As Integer) SpltDta = Left(FieldName, InStr(1, FieldName, ".") + intNo) End Function ويتم استدعاؤه من خلال بحيث ان Field Name اسم الحقل فى الاستعلام او مربع النص لو نموذج والرقم 2 هو عدد الارقام التى تريدها من بعد العلامة العشرية يمكنك زيادته او نقصانه حسب متطلباتك SpltDta([FieldName],2) ------------------- وللتاريخ كاملا استخدم الكود Format([FieldDate],"dd/mm/yyyy")

بالنسبة للرقم العشرى لابد من سؤال بناء عليه تتحدد الاجابة هل تريد التقريب الى اقرب رقم صحيح سواء اقل او اعلى ام تريد فقط اول رقمين بعد العلامة العشرية دون التقريب بالنسبة للتاريخ استخدم الدالة format لحذف رقمين من العام Format([FieldDate],"dd/mm/yy") وان اردت العام كاملا استخدم الكود الاتى لانى لا افهم ما تريد الحصول عليه تحديدا Format([FieldDate],"dd/mm/yyyy")

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

اتفضل يا استاذ @abouelhassan abouelhassan.accdb

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

اتفضل يا استاذ @at_aziz قمت بعمل الروتين الآتي ليقوم بإنشاء حقل لمسار الصورة الخاصة بالـ QR انظر الى الاستعلام qryData وهو الان مصدر بيانات كل من النموذج والتقرير تم انشاء المسار حسب الروتين من خلال الـ ID لأنني مسبقا جعلت صورة الـ Qr يتم انشاءها بناء على قيمة حقل الـ ID طبعا حضرتك تقدر تغير الى اى حقل غير الـ ID بس يكون يونيك طبعا بعد ذلك جعلت مصدر بيانات الصورة هو الحقل الجديد الذى تم انشاءه في الاستعلام Public Function QrImgPath(ByVal intNo As Integer) QrImgPath = CurrentProject.Path & "\Program Files\QR images\" & Dir(CurrentProject.Path & "\Program Files\QR images\" & intNo & ".png") End Function ---------------------- ويا استاذ @moamen salem تم التعديل فى المرفق كذلك حتى تحصل على النتيجة مؤمن سالم حسن عبداللطيف من خلال منشئ التعبير وليس من خلال الاكواد 386392877_GenerateOrReadQRCodeImageV.03.mdb

ابشر دقائق ويكون المرفق جاهز ان شاء الله

فى انتظار ردكم استاذى الحبيب @at_aziz

اتفضل =[txtFirstName] & Chr(13) & Chr(10) & [txtFatherName] وانظر الى الرابط الاتى https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/miscellaneous-constants طيب هل تريد ان أقوم بعمل ذلك في المرفق الرئيسي ام تريد ان تأتى بمرفقكم ليتم التعديل عليه مباشرة

______ __ __ ___ .__ __. _______ _______ __ ______ ______ .__ __. / || | | | / \ | \ | | / _____|| ____| | | / | / __ \ | \ | | | ,----'| |__| | / ^ \ | \| | | | __ | |__ | | | ,----'| | | | | \| | | | | __ | / /_\ \ | . ` | | | |_ | | __| | | | | | | | | | . ` | | `----.| | | | / _____ \ | |\ | | |__| | | |____ | | | `----.| `--' | | |\ | \______||__| |__| /__/ \__\ |__| \__| \______| |_______| |__| \______| \______/ |__| \__| تغيير شعار ميكروسوفت أكسس في TASK Manager في النموذج المرفق واستبداله بأيقونة أخرى يتم استدعاء الروتين من خلال وضع الكود الاتى فى حدث عند تحميل نموذج Call Xicon مع مراعاة تغيير البيانات الاتية فى رأس الموديول اسم التطبيق AppName اسم الايقونة بدون الامتداد icoName وتم عمل الكود على ان الايقونة فى نفس مسار القاعدة فى حالة تغيير مكان الايقونة لابد من تغير المسار فى الروتين AppIcon() Const AppName = "www.officena.net" Const icoName = "officenaIco" Public Function AppIcon() AppIcon = CurrentProject.Path & "\" & icoName & ".ico" End Function Public Function AccessIcon() AccessIcon = (SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE") Debug.Print AccessIcon End Function Function AddAppProperty(strName As String, _ varType As Variant, varValue As Variant) As Integer Dim dbs As Object, prp As Variant Const conPropNotFoundError = 3270 Set dbs = CurrentDb On Error GoTo AddProp_Err dbs.Properties(strName) = varValue AddAppProperty = True AddProp_Bye: Exit Function AddProp_Err: If Err = conPropNotFoundError Then Set prp = dbs.CreateProperty(strName, varType, varValue) dbs.Properties.Append prp Resume Else AddAppProperty = False Resume AddProp_Bye End If End Function Function Xicon() On Error GoTo ErrHandler Dim dbs As Object Set dbs = CurrentDb() Dim intX As Integer Const DB_Text As Long = 10 ' AppTitle intX = AddAppProperty("AppTitle", DB_Text, AppName) ' AppIcon Dim Chk Dim MyIcon As String Set Chk = CreateObject("Scripting.FileSystemObject") If Chk.FileExists(AppIcon()) = False Then MyIcon = (SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE") Else MyIcon = AppIcon() End If intX = AddAppProperty("AppIcon", DB_Text, MyIcon) dbs.Properties("UseAppIconForFrmRpt") = 1 Application.RefreshTitleBar exitProc: Exit Function ErrHandler: If Err = 3270 Then Resume Next Else MsgBox Err & Err.Description Resume exitProc End If End Function ---------------------------------------------------------------------

اتقضل يا سيدى 1569184222_GenerateOrReadQRCodeImageV.02.mdb

وعليكم السلام تعتمد طريقتى على الاكواد داخل موديول عام والذى يتم استدعاؤها من خلال وضع الكود الاتى فى حدث عند تحميل نموذج Call Xicon والكود داخل الموديول هو مع مراعاة تغيير البيانات الاتية فى رأس الموديول اسم التطبيق AppName اسم الايقونة بدون الامتداد icoName وتم عمل الكود على ان الايقونة فى نفس مسار القاعدة فى حالة تغيير مكان الايقونة لابد من تغير المسار فى الروتين AppIcon() Const AppName = "Alia Yusr El Din" Const icoName = "4" Public Function AppIcon() AppIcon = CurrentProject.Path & "\" & icoName & ".ico" End Function Public Function AccessIcon() AccessIcon = (SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE") Debug.Print AccessIcon End Function Function AddAppProperty(strName As String, _ varType As Variant, varValue As Variant) As Integer Dim dbs As Object, prp As Variant Const conPropNotFoundError = 3270 Set dbs = CurrentDb On Error GoTo AddProp_Err dbs.Properties(strName) = varValue AddAppProperty = True AddProp_Bye: Exit Function AddProp_Err: If Err = conPropNotFoundError Then Set prp = dbs.CreateProperty(strName, varType, varValue) dbs.Properties.Append prp Resume Else AddAppProperty = False Resume AddProp_Bye End If End Function Function Xicon() On Error GoTo ErrHandler Dim dbs As Object Set dbs = CurrentDb() Dim intX As Integer Const DB_Text As Long = 10 ' AppTitle intX = AddAppProperty("AppTitle", DB_Text, AppName) ' AppIcon Dim Chk Dim MyIcon As String Set Chk = CreateObject("Scripting.FileSystemObject") If Chk.FileExists(AppIcon()) = False Then MyIcon = (SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE") Else MyIcon = AppIcon() End If intX = AddAppProperty("AppIcon", DB_Text, MyIcon) dbs.Properties("UseAppIconForFrmRpt") = 1 Application.RefreshTitleBar exitProc: Exit Function ErrHandler: If Err = 3270 Then Resume Next Else MsgBox Err & Err.Description Resume exitProc End If End Function testIcon.zip

على كل حال جرب المرفق ولى عودة ان كان هناك جدوى 12.accdb