Moosak

التجربة الثانية : Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As _ Long Private Const KEYEVENTF_KEYUP = &H2 ' Get the current state of the NumLock key Function GetNumLockKey() As Boolean GetNumLockKey = GetKeyState(vbKeyNumlock) End Function Sub SetNumLockKey(ByVal newState As Boolean) ' if the current state must be changed If CBool(GetKeyState(vbKeyNumlock)) <> newState Then ' programmatically press and release the NumLock key keybd_event vbKeyNumlock, 0, 0, 0 keybd_event vbKeyNumlock, 0, KEYEVENTF_KEYUP, 0 End If End Sub والناتج : '=================================================== ' API Code Converter for Dual Compatibility (32-bit & 64-bit) ' Developed By Foksh (Officena.Net) ' Generated on: 2025-05-29 09:11:57 ' Tool version: v1.2 '=================================================== Private Const KEYEVENTF_KEYUP = &H2 #If VBA7 And Win64 Then ' 64-bit declarations Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As _ Long #Else ' 32-bit declarations Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As _ Long #End If أولا : ما أضاف الدوال GetNumLockKey و SetNumLockKey في الناتج تماما ..! ثانيا : لا حظت أنه بعد نسخ الناتج يمسحه من النموذج (الأفضل أن يضل مكانه ) في ظل وجود الزر (مسح الحقول) :

ماشاء الله عليك باش مهندس @Foksh 🙂🌹 اللي أجمل من التنفيذ هو الفكرة نفسها .. فتح الله عليك 😊 مبدأيا وأول تجربة للأداة .. شوف أنت واحكم بنفسك 😁: ' --------------------------<< المصدر >>---------------------- Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long ' --------------------------<< النــاتج >>---------------------- '=================================================== ' API Code Converter for Dual Compatibility (32-bit & 64-bit) ' Developed By Foksh (Officena.Net) ' Generated on: 2025-05-29 08:45:50 ' Tool version: v1.2 '=================================================== #If VBA7 And Win64 Then ' 64-bit declarations Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long #Else ' 32-bit declarations Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long #End If حاسس أنه ماشي تغير في دالة ال API أو فيه شي ناقص (PetrSafe) مثلا ؟؟!! 🤔 وللفائدة هذي مكتبات كبيرة لأكواد ال API ممكن تستفيد منها : https://binaryworld.net/Main/Api.aspx?L=3 http://vbnet.mvps.org/

وعليكم السلام ورحمة الله وبركاته 🙂 خلاصة تجارب الخبراء .. هي كنوز لنا على طبق من ذهب 😊🌹 عندي ملاحظتين في بالي ( أفكار لا تزيد ولا تنقص من روعة الموضوع )😁 : 1- موضوع استخدام ال TempVars جميل جدا للسبب الذي ذكرته أنت (إفراغ الذاكرة عند حدوث خطأ ) ، ولكن كمجرد فضفضة .. موضوع استدعاء البيانات من الجداول مرة واحدة عند تشغيل البرنامج قد يؤثر على أنه لو تم تحديث البيانات بعد التشغيل فهذا لن يحدث البيانات التي في الذاكرة إلا إن تم تشغيل أكواد تخزين البيانات في حواصل المتغيرات مجددا ... وأضنك منتبه لهذه النقطة 🙂👌.. ويسترعي الانتباه أيضا إلى أنك حتى لو عملت لها تحديث بعد تغيير البيانات فإنها ستتحدث عندك في جهازك وقد لا تتحدث عند المستخدمين الآخرين الذين شغلوا أجهزتهم قبلك 😅🖐️ ... 2- روابط مواقع حفظ الملفات (Files Paths) عندما تكتب كاملة كما هي مع اسم القرص ( \:C أو \:D ) مثلا تجعل مواقع الملفات غير مقرؤة في حال تم نقل موقع المشروع .. لذلك يفضل أن يتم تخزين موقع هذه الملفات من قاعدة البيانات (سواء كانت تتبع ال FE أو ال BE ) والكود يكمل باقي الرابط بالمواقع المناسب .. مثال على ما أقصده لو كان الشعار في الرابط التالي : C:\Project Folder\Project BE\Images\LOGOs\CompanyLogo.PNG فأنت ستحتفظ في الجدول بالجزء البرتقالي فقط وتترك الباقي للبرنامج ليكمله .. وسلامتكم 🙂🌹

طبعا طريقتي لا تختلف عن ما ذكره الإخوة المهندسين الأعزاء 🙂 ولكن لدي صورة للنموذج الذي أستخدمه لضبط هذه الإعدادات : والذي يستند بطبيعة الحال إلى جدول خاص بحفظ هذه البيانات يحتوي على سجل واحد فقط .. ومن ثم قمت يعمل موديول وبه عدة إجرائيات تقوم باختصار المسافة علي لاستدعاء هذه البيانات في أي مكان بالبرنامج .. مثال : Public Function AppSett_OrganizationName() As String ' اسم المؤسسة AppSett_OrganizationName = Nz(DLookup("OrganizationName", "[AppSettingesT]"), "") End Function Public Function AppSett_OrgBranch() As String ' الفرع AppSett_OrgBranch = Nz(DLookup("OrgBranch", "[AppSettingesT]"), "") End Function Public Function AppSett_Org_Adress() As String ' عنوان المؤسسة AppSett_Org_Adress = Nz(DLookup("Org_Adress", "[AppSettingesT]"), "") End Function Public Function AppSett_Show_Adress_In_Reports() As Boolean ' إظهار العنوان في التقارير AppSett_Show_Adress_In_Reports = Nz(DLookup("Show_Adress_In_Reports", "[AppSettingesT]"), 0) End Function Public Function AppSett_OrganizationLogoPath() As String ' رابط الشعار الأول AppSett_OrganizationLogoPath = Nz(DLookup("OrganizationLogoPath", "[AppSettingesT]"), "") End Function Public Function AppSett_OrganizationLogoPath2() As String ' رابط الشعار الثاني AppSett_OrganizationLogoPath2 = Nz(DLookup("[OrganizationLogoPath2]", "[AppSettingesT]"), "") End Function فلو أردت استدعاء رابط الشعار الأول في التقرير مثلا .. أعمل مربع صورة وأجعل مصدر بياناته كالتالي : = AppSett_OrganizationLogoPath() ولو بغيت أظهر عنوان المؤسسة في التقرير أعمل مربع نص وأخلي مصدر بياناته : = AppSett_Org_Adress() وسلامتكم 🙂🖐

علشان فاضل ساعة على موعد الدوا بتاع الـ.................. 😂😂 أنتبهت لاحقا أنك ذاكرها بس مش حاطها من ضمن الأمثلة 😎✌ يا تحفة 😁👊

أفكار لامعة أخي فادي @Foksh 😊👌🌷 .. لك أجمل تحية 😊🌹 ما أجمل هذي الأدوات اللي تسهل العمل وتضع الحلول الجذرية لأغلب المشاكل اللي تواجهنا .. ............ بصراحة أحاول أحشر نفسي في الموضوع لكن ما عندي شي أضيفة بعد ملاحظات فطاحلة الأكسس هنا 😅🖐 لذلك سألتزم المتابعة والاستفادة وجني الثمار بعد نضجها إن شاء الله 😄✌🌹🌟🌷

ما شاء الله تبارك الله ... 😊🌹🌟 تحفة فنية نزين بيها المكتبة العامرة .. من واحد تحفة 😁👌🌷 الميزة هذي إنت ذاكرها من ضمن المميزات 😎☝

أهلا بك أخي يوسف ... 🙂 جربت الكود أكثر من مرة وبيفتح عندي ال My Computer على طول في خطوة واحدة .. كيف كتبت الكود أنت ؟

مرجع قيم ماشاء الله 🌼 من زمان نفسي أتعلم عن ال OOP و الكلاس موديول لكن حاسس نفسي ما ملحق 😅🖐 شكرا أخي @athal1 على النقل والمشاركة 🙂🌷

ضع هذا السطر على أمر عند النقر للزر : Shell "explorer shell:MyComputerFolder", vbNormalFocus 🙂

العفو معلمنا العود 😊🌷 الآن صارت أجمل بمرورك 🌼

وعليكم السلام ورحمة الله وبركاته ..🙂 فعلا النسخة قديمة وتحتاج لتحديث يتوافق مع تطورات النسخ الجديدة للواتسأب ..

سعيد جدا لسعادتك بها 😄✌ .. وهناك تحديث مهم لها أيضا قادم في الطريق .. إن شاء الله 😊🌷 التحديث القادم تم إضافة كتابة أكواد ال DB.OpenRecordset للجداول .. قادمة في الطريق العقل المفكر والمبدع المتميز يتكلم .. وناسي أنه هو اللي مكسر الدنيا 😎 هذا واحد من أحلامي ✌ ياليت أحصل فرصة وأعمل درس في جماليات تصاميم النماذج يا ترى هل فيه حد مهتم بهذا الموضوع ؟؟

وعليكم السلام 🙂 عدل كود فتح التقرير هكذا : DoCmd.OpenReport "rprepnu2", acViewPreview, , "[lagnano] >= " & Nz(Me.tt1, 0) & " And [lagnano] <= " & Nz(Me.tt2, 0), acNormal lagna2.accdb

السلام عليكم ورحمة الله وبركاته هذا تحديث بسيط ومهم في نفس الوقت على هذه الأداة الجميلة 🙂 ( عون المثابر في الحصول على أسماء العناصر (الإصدار 3.0)) كما علمتم هذه الأداة صممتها بفضل الله في أكسس تقوم بإحضار وسرد أسماء العناصر لك لكي تستطيع نسخها ولصقها في أي مكان تريد بكل سهولة ويسر 🙂 شخصيا أستفدت كثيرا منها وسهلت علي الكثير من الجهد وقلصت من وقت العمل بحمد الله وفضله. :: ما الجديد في النسخة 3.0 :: تم إضافة خانة في الأخير خاصة بالجداول فقط .. : وهي عند اختيار الجدول يتم كتابة جمل SQL أستعلامات أساسية للجدول المختار مع ذكر أسماء حقول الجدول مع مراعاة أنواع الحقول وكتابتها بشكل سليم في الكود .. طبعا الأداة ستعطيك الجمل الاستعلامية الأربعة SELECT, INSERT INTO, UPDATE ,DELETE والكود الناتج جاهز للصقه مباشرة في محرر الأكواد VBA .. عليك فقط أن تقوم ببعض التعديلات الطفيفة كإزالة الحقول الزائدة أو الغير مستهدفة وكذلك تحديد الشرط Where في حال التحديث أو الحذف مثلا . :: لقطة للنسخة 3.0 :: وهذا مثال على جمل ال SQL الناتجة : ' SELECT statement Dim sqlSelect As String sqlSelect = "SELECT [ID], [First Name], [Last Name], [Gender], [Age], [Email], [Phone], [Education], [Occupation], [Salary], [StaffNumber], [IsActive], [DOB]" sqlSelect = sqlSelect & vbCrLf & " FROM [SampleTable]" '============================================================ ' INSERT INTO statement Dim sqlInsert As String sqlInsert = "INSERT INTO [SampleTable] ([ID], [First Name], [Last Name], [Gender], [Age], [Email], [Phone], [Education], [Occupation], [Salary], [StaffNumber], [IsActive], [DOB])" sqlInsert = sqlInsert & vbCrLf & " VALUES (" & var_ID & ", '" & var_FirstName & "', '" & var_LastName & "', '" & var_Gender & "', " & var_Age & ", '" & var_Email & "', '" & var_Phone & "', '" & var_Education & "', '" & var_Occupation & "', " & var_Salary & ", " & var_StaffNumber & ", " & IIf(var_IsActive, -1, 0) & ", #" & var_DOB & "#)" '============================================================ ' UPDATE statement Dim sqlUpdate As String sqlUpdate = "UPDATE [SampleTable]" sqlUpdate = sqlUpdate & vbCrLf & " SET [ID] = " & var_ID & ", [First Name] = '" & var_FirstName & "', [Last Name] = '" & var_LastName & "', [Gender] = '" & var_Gender & "', [Age] = " & var_Age & ", [Email] = '" & var_Email & "', [Phone] = '" & var_Phone & "', [Education] = '" & var_Education & "', [Occupation] = '" & var_Occupation & "', [Salary] = " & var_Salary & ", [StaffNumber] = " & var_StaffNumber & ", [IsActive] = " & IIf(var_IsActive, -1, 0) & ", [DOB] = #" & var_DOB & "#" sqlUpdate = sqlUpdate & vbCrLf & " WHERE [SomeField] = SomeValue" '============================================================ ' DELETE statement Dim sqlDelete As String sqlDelete = "DELETE FROM [SampleTable]" sqlDelete = sqlDelete & vbCrLf & " WHERE [SomeField] = SomeValue" الشرح القديم للأداة على اليوتيوب 🙂 متابعة ممتعة 😊👌🏼 ولا أستغني عن آراءكم وملاحظاتكم .. 🙂 لتحميل الملف :

وعليكم السلام ورحمة الله وبركاته .. حيا الله بمهندسنا العود @jjafferr 😃🖐 هذي اللخبطة تحصل لما يكون الكود فيه نص عربي وتجى تنسخه لما يكون مؤشر اللغة على الإنجليزي >>> وهذا عندك مثال للتجربة 🙂 : Function GetFileExt(strPath As String) As String ' ÏÇáÉ ááÍÕæá Úáì ÅãÊÏÇÏ ÇáãáÝÇÊ ãÚ ÇáäÞØÉ Dim strFile As String strFile = Right(strPath, Len(strPath) - InStrRev(strPath, "\")) GetFileExt = Right(strFile, Len(strFile) - InStrRev(strFile, ".") + 1) End Function

جرب تبحث هنا 🙂 : https://arbfonts.com/naskh-arabic-fonts/page/15?preview=الجمهورية+الجزائرية

تلخيص جميل جدا .. 🙂 رزقك الله بنوته جميلة .. 👩 .. تتربى في عزك على الطاعة .. 🌷

صوت الضمير 😊🖐️ أمال كل الدوشة اللي عملتها جوة دي تسميها أيه ؟؟ 🙃

سلمت يمناك مولانا @ابو جودي 😃🖐 ... إضافة مميزة وتنسيق يدل على جمال وإتقان صاحبه 😎✌ تم إضافة النسخة الجديدة بتنسيقات وتحسينات المعلم المبدع @ابو جودي

هذي الصرخات هي اللي مجننتنا 😂 من الأشياء اللي لاحظتها على نسخة الأوفيس 365 أن هذولا السطرين ما يشتغلوا معاي .. ولا أدري أيش السبب !!! ولذلك بحثت عن بديل .. فكان ما رأيت وبصراحة ما كثرت من البحث .. أول ما لقيت هذي الأكواد وجربتها أعتمدتها على طوووووول 😅🖐

أنت ناقد جيد ما شاء الله عليك 😅🖐 1- الأول تم تطبيقه بناءا على اقتراحك 🙂 . 2- الثاني : لا أدري 😁👊 جرب وأخبرنا ..

اعرض الملف ⚙🛠🎁 أداة لإصلاح وتعديل النصوص العربية التالفة في الأكواد .. من > ÇáÓáÇã Úáíßã إلى > السلام عليكم :: السلام عليكم ورحمة الله وبركاته :: نظرا لوجود مشكلة عند نسخ النصوص العربية في أكواد VBA وخصوصا عندما تكون لغة النظام معينة على اللغة الإنجليزية .. لذلك قمت بتصميم هذه الأداة لتقوم بإصلاح العبارات العربية التالفة في الكود وإرجاعها إلى أصلها ... مثال : ÇáÓáÇã Úáíßã >>>> تعود لأصلها : السلام عليكم وهذه صورة للأداة : صاحب الملف Moosak تمت الاضافه 04/22/25 الاقسام قسم الأكسيس  

شكرا جزيلا بحجم السماء مهندسنا العزيز @Foksh 😊👏 كفيت ووفيت .. تحفة راااائعة وإضافة قيمة جدا للمكتبة العربية .. جزاك الله عنا كل خير .. وغفر الله لك ولوالديك ولمن تحب 🌹🌷