Ahmos
-
Posts
112 -
تاريخ الانضمام
-
تاريخ اخر زياره
-
Days Won
3
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
مشاركات المكتوبه بواسطه Ahmos
-
-
الأخوة الكرام
أسعد الله مساءكم ووفقكم لك خير
تحديث جديد يتضمن بعض التعديلات علي نموذج الـ html
وهي
1- تم إضافة ميزة البحث بقيم متعدده يفصل بينهم | أو ; أو , وهذا في البحث العام او الحث الخاص بكل نموذج (2)
3- ميزة نسخ كامل محتوي العمود مع أمكانية أختيار الفاصل بينهم او كتابة فاصل جديد (4) وأيضاً اختيار ضم عنوان العمود أم لا (5)
6- تم معالجة بعض القيم لعرض أفضل
7- تم تحسين طريقة نسخ محتوي الخلية للتناسب مع الخلية التي تحمل رابط بداخلها
صوره لبعض النتائج
بالتوفيق-
1
-
1
-
-
@عاشق_الرقي
شاكر لك أخي الكريم كلامك الطيب
أسئلك الدعاء وأسئل الله لك التوفيق وان يجعلك من العلماء الصالحين النافعين -
@سامي الحداد
بارك الله فيك، ونفع بك وزادك من فضله@moho58
آمين
بارك الله فيك شكراً جزيلاً -
وعليكم السلام ورحمة الله وبركاته أخي @سامي الحداد
الله يسلمك، شكراً جزيلاً -
السلام عليكم ورحمة الله وبركاته
المطلوب حسب ما فهمت هو :
إضافةً إلي ما يفعلة إستعلام التحديث الحالي انت تريد تحديث العمود G N
بأخر رقم موجود في جدول الجرد
تفضل أخي الكريم جرب هذا الكودPublic Function arTableName() As String arTableName = ChrW(1580) & ChrW(1583) & ChrW(1608) & ChrW(1604) & ChrW(32) & _ ChrW(1578) & ChrW(1587) & ChrW(1580) & ChrW(1610) & ChrW(1604) & ChrW(32) & _ ChrW(1575) & ChrW(1604) & ChrW(1603) & ChrW(1578) & ChrW(1576) End Function Private Sub أمر8_Click() Dim arTblName As String Dim maxGN As Long Dim arMsgPrompt As String Dim arMsgTitle As String Dim msgResponse As VbMsgBoxResult On Error GoTo ErrorHandler arTblName = arTableName maxGN = Nz(DMax("[No_Gard]", "[T_Gard]"), 0) arMsgTitle = "تأكيد تنفيذ الأمر" arMsgPrompt = "أنت على وشك تحديث حالة جميع الكتب باليومية" arMsgPrompt = arMsgPrompt & vbCrLf & "من كتب موجودة إلى كتب فاقد" arMsgPrompt = arMsgPrompt & vbCrLf & "لتأكيد الأمر أضغط موافق ، ولإلغائه أضغط إلغاء" msgResponse = MsgBox(arMsgPrompt, vbQuestion + vbOKCancel + vbMsgBoxRight, arMsgTitle) strSQL = "UPDATE [" & arTblName & "]" & vbCrLf & _ " SET [" & arTblName & "].CaseBook = ""فاقد""," & vbCrLf & _ " [" & arTblName & "].[G N] = " & maxGN & vbCrLf & _ " WHERE ((([" & arTblName & "].CaseBook)=""موجود"")" & vbCrLf & _ " AND (Not ([" & arTblName & "].title) Is Null)" & vbCrLf & _ " AND (([" & arTblName & "].searinumber) Between [forms]![F_GardBooks]![text]" & vbCrLf & _ " AND [forms]![F_GardBooks]![text2]))" & vbCrLf & _ " OR ((([" & arTblName & "].CaseBook)=""موجود"")" & vbCrLf & _ " AND (([" & arTblName & "].title) Is Null)" & vbCrLf & _ " AND (([" & arTblName & "].searinumber) Between [forms]![F_GardBooks]![text]" & vbCrLf & _ " AND [forms]![F_GardBooks]![text2]));" If msgResponse = vbOK Then DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True MsgBox "تم تحديث البيانات بنجاح والحمد لله" Else End If Exit Sub ErrorHandler: Debug.Print Err.Number; Err.Description End Sub
تم إضافة هذه الوظيفة {arTableName} لتعود بإسم الجدول العربي
أنصح بإستخدامها
كما تم تنسيق الكود قليلاً
وإضافة { " [" & arTblName & "].[G N] = " & maxGN }
لإضافة التحديث المطلوبإضافة بالنسبة للأستعلام الموجود بأسم {استعلام1}
Nz(DMax("[No_Gard]", "[T_Gard]"), 0) (SELECT Max(T_Gard.No_Gard) FROM T_Gard)
بالتوفيق
-
1
-
-
اللهم بارك فيه وفي علمه وعمله
وأجعل عمله خالصاً لك وحدك يارب العالمين
اللهم زد وبارك
مبارك عليك أخي فادي @Foksh
ماشاء الله تبارك الله أعمالك مميزة وجميلة زادك الله حرصاً وإتقاناً
بالتوفيق ❤️-
1
-
-
@ابو جودي
آمين
بارك الله فيك، و شكراً جزيلاً لك أخي الكريم
اللهم أرضَ عن عبدك وثبته علي دينك@عاشق_الرقي
آمين
بارك الله فيك، ورزقك علماً نافعاً ينتفع به
وأسئل الله العلي القدير أن ينعم عليك ويزيدك من فضله@عمر ضاحى
بارك الله فيك وفي علمك وعملك
شكراً جزيلاً -
@kanory
بارك الله فيك
شكراً جزيلاً -
@Moosak
أخي الكريم، شكراً جزيلاً
آمين
بارك الله فيك وزادك من فضله ونفع بك وعفا عنك وعافاك@ابوخليل
أخي الكريم، شكراً جزيلاً
آمين اللهم تقبل
أسئل الله العلي القدير أن ييسر لك الخير حيث كان ورزقك علماً نافعاً ينتفع به@Foksh
أخي الكريم، شكراً جزيلاً
بارك الله فيك، متشكر علي الكلام الجميل ده
نفع الله بك وبعلمك وزادك من فضله@محمد طاهر عرفه
الأستاذ الفاضل
بارك الله فيك، شكراً جزيلاًأسعدكم الله جميعاً وبارك فيكم ورزقكم علماً نافعاً ينتفع به
وجمعني بكم علي خير في جنات النعيم رفقة النبيين والصديقين والشهداء والصالحين وحسن أولئك رفيقا-
2
-
-
@شايب
شكراً جزيلاً لك أخي الكريم
بارك الله فيك
أسئلك الدعاء بالتوفيق والسداد
فالحمد لله والشكر له علي كل شي { سبحان الله وبحمده سبحان الله العظيم }
أشعر اني مازلت هاوي مجتهد
وصدقاً أجد فيكم الكثير من المعلمين الأفاضل
ولكني سأعتز بهذه الترقية ولو لم أكن أستحقها 😁-
1
-
-
وعليكم السلام ورحمة الله وبركاته
أسعدتني، بارك الله فيك
فهي شهادة يعتز بها منكم أنتم الخبراء الحقيقين
أسئل الله لكم التوفيق والنجاح-
1
-
-
الشكر ليك أخي الكريم
دي شهادة أعتز بها
شكراً جزيلاً
بارك الله فيكم -
@jjafferr
أخي الفاضل أسعد الله صباحك بكل الخير
1- أحتاج في عملي الي التعامل كثيراً مع بيانات متغيرة ولتسهيل مراجعتها قمت بعمل نموذج يسمح لي باضافة بعض القواعد للتحقق من البيانات وتلوينها حتي تتم المراجعة والفرز بشكل أسرع
لذلك فكرت في هذا العمل حتي أتمكن من تحويل أي جدول2- مشاركة بعض الجداول التي تحتوي علي بيانات مرجعية قد تحتاج الوصول اليها في اي وقت
فيمكنك من خلال تليفونك عمل بحث وتصدير وارسال ملف الأكسل بالبيانات المطلوبة فقط
كما يوجد وظيفة تمكنك من نسخ محتوي الخلية بمجرد الضغط عليها3- عند التعامل مع بيانات متغيرة أقوم ببناء جداول كثيرة برمجياً لأنها جداول مؤقتة ولا حاجة لإعداد نماذج داخلية بالبرنامج أقوم بتعبتها وتفريغها
عند الإنتهاء اما اضعها في المحفظة CLipBoard ثم انسخها داخل ملف اكسيل
او اقوم بتصديرها بصيغة CSV
الأن أصبح لدي خيار ثالث بمميزات أفضل
هذه الأسباب الأساسية
-
-
-
السلام عليكم ورحمة الله وبركاته
الأخوة والأخوات الكرام
تحية طيبة وبعد،،،يوجد بالمرفقات ثلاث ملفات بعد فك الضغط
1- نموذج الـ Html باسم {ahmosAutoHtmlTemplate_V10} وتحتاج إليه فقط اذا اردت التعديل او اضافة اي شي للنموذج بشكل دائم
ولإضافتة داخل البرنامج :
- قم بنسخ كامل المحتوي ثم قم بتشغيل الكود التالي : [Call splitAutoTableSections]2- ملف نصي باسم {Text_Table_Sample} ويستخدم بنسخ محتواه ثم الضغ علي الزر [Convert Copied Text To html] بالنموذج
يتضمن هذا الملف مثال لجدول محدد بالعلامات التالية\t ---> vbTab علامة الفصل بين الأعمدة \n ---> vbLf علامة فصل السطور داخل الخلية \r\n -> vbNewLine علامة السطر الجديد
3- البرنامج باسم {Ahmos_AutoHtmlTable}
يقوم البرنامج بتحويل الجداول الداخلية باستخدام استعلامات الـ SQL الي صفحة ويب
و اي جدول خارجي عن طريق نسخ الجدول بالكامل
او إذا كان الجدول علي شكل نص تم تجميعة برمجياً
يوجد أمثلة كما يمكنك التجربة علي اي ملف اكسيلمع بعض الصور
بعض أهم النقاط :
1- داخل هذه الوظيفة { Public Function autoTblBody } يتم معالجة محتوي الخلية للجداول الخارجية
وهنا تم إضافة بعض المعاير مثل إذا كان المحتوي رقم اقل او بساوي 5 يتم توسيطة داخل الخلية
اذا كانت القيم TRUE or False / YES or No يتم التوسيط وتغير اللون
إذا كانت بداية الخلية = او ' يتم إزالتها
وكذلك الوظيفة الخاصة بالجداول الداخلية { Public Function sqlToHtmlTbl }2- يمكن إضافة عمود فارغ علي صفحة الـ HTML باستخدام addRecNumField = True
وهو يضيف عمود recNum
وفائدة هذا العمود يوجد وظيفة داخل الـ JavaScript تقوم بعمل ترقيم تلقائي لهذا العمود
يتم الترقيم التلقائي عن
1- فتح الصفحة
2- عند التصدير وذلك حتي يتم تعدل الارقام علي الصفوف الظاهرة فقط
3- عند عمل إلي للتصفية Clear Filters
الوظيفة هيfunction renumberTableColumn(columnHeadName, filterOnly = false)ويمكن ان تستخدم لترقيم اي عمود بكتابة اسم العمود بدل من columnHeadName هكذا 'recNum'
اما filterOnly تحدد إذا كنت تريد ترقيم الصفوف الظاهرة فقط ام كامل الصفوف
false كامل الصفوف
true الظاهرة فقط اي ما يتبقي بعد البحث او التصفية3- وظيفة saveTable
تمكنك من حفظ الصفحة مرة اخري وفائدتها هي ان تقوم بحفظ نسخة اخري من الصفحة بعد حذف أعمدة او تصيفة صفوفfunction saveTable(deleteHiddenRows = true)وهي بشكل افتراضي تقوم بحذف الصفوف الغير ظاهرة من النسخة وليس من الأصل
4- ستجد Optional ByVal constFileName As String = "", _
داخل الوظيفة { strTbltToHtml و sqlTbltToHtml }
ويسخدم هذا في تعديل هذه القيمة داخل نموذج الـ Html
$fileName$<span id="fileName" style="display: none;">$fileName$</span>وفائدتة هي وجود وظيفة في الـ java script {getExportFileName} تقوم بتحديد اسم الملف عند التصدير وتقوم بإضافة الوقت والتاريخ له
فاذا كانت القيمة هنا $fileName$ او فارغة سيتم استخدام قيمة افتراضية [ahmosExTable] وغير ذلك ستسخدم
أغلب وظائف الـ java script قمت بها بمساعدة الـ AI
ولكن الحمد لله فاهمها بنسبة كبيرة 😁بالتوفيق
-
5
-
1
-
-
السلام عليكم ورحمة الله وبركاته
أسعد الله أوقاتكم وبارك فيكم
الملف المرفق يحتوي علي- [ awsTimer ] وهو [ CLass Module ] والموضوع الأساسي
- [ awsStringBuilder] وهو [ CLass Module ] و موضوع فرعي
- [ awsSleepWait_MOD ] وهو [ Module ] و موضوع فرعي
- الباقي المواضيع الخاصة بهم بالمنتدي
[ awsSleepWait_MOD ] - ببساطة وظيفته هي إيقاف عمل الكود لبعض الوقت ولسهولة الاستخدام
تم إضافة وحدات للوقت (الوحدة الافتراضية الثواني) و يستخدم هكذا :
- Call waitFor(500, wtMilliseconds)
- Call waitFor(5, wtSeconds)
- Call waitFor(1, wtMinutes)
[ awsStringBuilder ] - وظيفة هذه الأداة هو تكوين النصوص الكبيرة بسرعة أكبر بكثير تصل إلي 98 % من الطريقة العادية
لن أطيل فالحديث عنها لأنني وصلت إليها حديثاً ووجدت مصادر عده ولكن أغلبها قديم ولم أفحص الموضوع بعناية كبيرة
لذا سأكتفي بمشاركة المصادر والوظيفة داخل الكود كما يوجد مثال Advanced_awsTimerTest
ملحوظة المديول هام للوظيفة الأساسية لأنه مستخدم لبناء التقرير (النص والـ HTML)
المصادر : https://nolongerset.com/string-concatenation-in-vba/ https://nolongerset.com/clsconcat/ https://github.com/joyfullservice/msaccess-vcs-addin/blob/main/Version%20Control.accda.src/modules/clsConcat.cls https://codereview.stackexchange.com/questions/67596/a-lightning-fast-stringbuilder/67600#67600 https://github.com/retailcoder/VBA-StringBuilder/blob/master/src/StringBuilder.cls https://www.vbforums.com/showthread.php?847365-VB6-StringBuilder-Fast-string-concatenation&s=43cda60b1b8cb40b2feaa60b32df951d https://github.com/dragokas/hijackthis/blob/devel/src/clsStringBuilder.cls نتائج التجربة : Normal Test Starts .... Normal String Length is : 944594 Normal Test Takes : 40.794s Normal Test End. SB Test Starts .... String Builder Length is : 894294 sb Way Length is : 894294 awsString builder Test Takes : 638ms sb Test End. AWS StringBuilder is 98.43% faster than the normal way.
[ awsTimer ] - وهو موضوعنا الأساسي
الأستخدام التقليدي : هو لحساب وقت أي عملية ويستخدم هكذا
1- تهية الـ Class module دخل الكود الخاص بك يتم بطريقتين أفضل الأولي
Sub initialize_awsTimer_1() Dim sTimer As awsTimer Set sTimer = New awsTimer Set sTimer = Nothing End Sub
Sub initialize_awsTimer_2() Dim sTimer As New awsTimer End Subبعد ذلك لبدأ حساب الوقت sTimer.startTimer
بعد بدأ الوقت يمكنك معرفة الوقت ميلي ثانية في أي لحظة من خلال Debug.Print .elapsedMS
ويمكنك أيضاً الحصول علي الوقت منسق بالثواني والدقائق وهكذا من خلال Debug.Print .getFormattedTime(, tuSeconds)
كما يمكن استخدام نفس الوظيفة لتنسق اي ميلي ثانية
Debug.Print .getFormattedTime(6042, tuMilliseconds)
Debug.Print .getFormattedTime(260, tuSeconds)
Debug.Print .getFormattedTime(13.15, tuMinutes)
ولإيقاف الوقت sTimer.stopTimer بعد إيقاف الوقت سيتوقف العد ولن تتمكن من بدأ او استكمل الحساب إلا بتهيئة جديدة
الأستخدام المطور :مقدمة : يوجد لدي بعض الإجراءات التي تحتاج الي ما يقارب الـ 4 ساعات وهي تضم عمل العديد من الأكواد
ولمتابعة عمل الأكواد وتسجيل الاحداث ووقت كل عملية والأخطأ والمعلومات كنت أقوم بذلك لكل منها ومن ثم تحليل المعلومات
وذلك بشكل أساسي لتحسين وتسريع العملية وعليه فكرت في تطور مديول حساب الوقت ليتضمن الأتي
- sTimer.pauseTimer وذلك لكي يتوقف عد الوقت ويستخدم عندما تريد إستثناء بعض الاجراءات مثال
إذا اردت إستثناء وقت ظهور الرسالة للمستخدم وإنتظار إجابته عليها
- sTimer.startTimer للبدأ والإستكمال بعد التوقف المؤقت
- sTimer.addStep "Step1" وذلك لإضافة مرحلة وتستخدم للتحليل فيمكن حساب فرق الوقت بين المراحل كما فالتقرير النهائي يتم تحليل جميع المراحل
- sTimer.getStepDiff "Step1", "Step2" وذلك لمعرفة الفرق بين مرحلتين بالميلي ثانية
- sTimer.addInfo "UserName", "Ahmos" وذلك لإضافة معلومات كأسم الوظيفة التس ستبدأ او اسم المستخدم
- sTimer.addError _ لإضافة الأخطاء أثناء عمل الأكواد
"Source", _ مصدر الخطأ
"error Number", _ رقم الخطأ
"error Description" وصف الخطأ
- sTimer.getAwsTimerInfo للحصول علي كافة البيانات
- sTimer..exportLog "filePath", txt لتصدير النتائج يوجد نوعين (TXT and HTML)
كما يتم التعامل مع 3 مسارات
1- يسمح لك إضافة مسار ملف كامل مع إسم الملف وسيتم التحقق من المسار وإذا امكن إنشاء الملف سيتم الكتابة بداخلة
وإذا لم تدخل المسار سيتم اختيار مسار البرنامج وإذا نجح في إنشاء الملف بهذا المسار سيكتب بداخله وإذا فشل سيتم تصدير الملف لسطح المكتب
هناك بعض التفاصيل البسيطةمثال للناتج Basic_awsTimerTest داخل مديول awsTimer_Test_MOD
#-----------------------------------------------------------------------------------------------------------# ¦ AWS TIMER LOG ¦ ¦ Generated: 27/11/2024 05:52:41 PM ¦ #-----------------------------------------------------------------------------------------------------------# #-----------------------------------------------------------------------------------------------------------# ¦ COLLECTED INFORMATION ¦ #-----------------------------------------------------------------------------------------------------------¦ ¦Key ¦ Value ¦ #-----------------------------------------------------------------------------------------------------------¦ ¦initializedAt ¦ 27/11/2024 05:52:36 PM ¦ ¦currentPath ¦ D:\FOLDER\awsTimer\ ¦ ¦User ¦ UserName ¦ ¦startedAt ¦ 27/11/2024 05:52:36 PM ¦ ¦isoStart ¦ 2024-11-27T17:52:36.000 ¦ ¦startTime ¦ 0.0316 ¦ ¦pausedAt ¦ 27/11/2024 05:52:37 PM ¦ ¦pausedTime ¦ 1013.422 ¦ ¦pausedFormatted ¦ 1.013s ¦ ¦resumedAt ¦ 27/11/2024 05:52:38 PM ¦ ¦RunSub1 ¦ 1013.5207 ¦ ¦RunSub2 ¦ 2024.4509 ¦ ¦Step ¦ 3040.6271 ¦ ¦endTime ¦ 3047.2817 ¦ ¦stoppedAt ¦ 27/11/2024 05:52:40 PM ¦ ¦isoEnd ¦ 2024-11-27T17:52:40.000 ¦ ¦totalTime ¦ 3.047s ¦ ¦filePath ¦ D:\FOLDER\awsTimer\awsTimerLog_27.11.2024_05.52.41_PM.txt ¦ ¦folderPath ¦ D:\FOLDER\awsTimer\ ¦ ¦exportedAt ¦ 27/11/2024 05:52:41 PM ¦ ¦filePath_1 ¦ D:\FOLDER\awsTimer\awsTimerLog_27.11.2024_05.52.41_PM.html ¦ ¦folderPath_1 ¦ D:\FOLDER\awsTimer\ ¦ ¦exportedAt_1 ¦ 27/11/2024 05:52:41 PM ¦ #-----------------------------------------------------------------------------------------------------------# #-----------------------------------------------------------------------------------------------------------# ¦ STEP TIMING ANALYSIS ¦ #-----------------------------------------------------------------------------------------------------------¦ ¦Start Step ¦ End Step ¦ Duration ¦ #-----------------------------------------------------------------------------------------------------------¦ ¦startTime ¦ RunSub1 ¦ 1.013s ¦ ¦RunSub1 ¦ RunSub2 ¦ 1.010s ¦ ¦RunSub2 ¦ Step ¦ 1.016s ¦ ¦Step ¦ endTime ¦ 6ms ¦ ¦startTime ¦ endTime ¦ 3.047s ¦ #-----------------------------------------------------------------------------------------------------------# #-----------------------------------------------------------------------------------------------------------# ¦ ERRORS ENCOUNTERED ¦ #-----------------------------------------------------------------------------------------------------------¦ ¦Location ¦ Error Details ¦ #-----------------------------------------------------------------------------------------------------------¦ ¦Source ¦ 12345_Testing add an error._27/11/2024 05:52:41 PM ¦ #-----------------------------------------------------------------------------------------------------------#
تعديلاتكم وإضافاتكم واستفساراتكم محل ترحيب.
بالتوفيق!
بالتوفيق
-
1
-
لمعرفة إذا كانت قاعدة الحالية تعمل من موقع موثوق أم لا
فيمكن تطبيق الأمر التالي? CurrentProject.IsTrusted
يرجع بـ TRUE إذا كانت تعمل من موقع موثوق أما إذا كان لا فلا يعود بـ False
إنما تظهر الرسالة التالية
ولذلك تم إضافة الأكواد التالية لمعرفة الحالة
هناك إحتمالين
1- ان قاعدة البيانات تعمل من مسار رئيسي مضاف للمواقع الموثوقة
2- ان القاعدة تعمل من مسار فرعي ضمن مسار رئيسي مضافة لموقع موثوق + السماح للمجلدات الفرعي مفعل داخل الموقع
AllowSubfolders = 1
لذلك أولاً نحتاج إلي هذه الأكواد ويفضل إضافتها للمديول (Helper_Functions)
Public Function isPathOrSub(ByVal basePath As String, ByVal pathToCheck As String) As Boolean Dim sBPath As String Dim sCPath As String sBPath = validTLocPath(Trim(basePath), True) sBPath = Replace(sBPath, "/", "\") sBPath = addTrailSlash(sBPath) sBPath = LCase(sBPath) sCPath = validTLocPath(Trim(pathToCheck), True) sCPath = Replace(sCPath, "/", "\") sCPath = addTrailSlash(sCPath) sCPath = LCase(sCPath) isPathOrSub = (sBPath = sCPath) Or (sBPath = Left(sCPath, Len(sBPath))) End Function Public Function isSubPath(ByVal basePath As String, ByVal pathToCheck As String) As Boolean Dim sBPath As String Dim sCPath As String sBPath = validTLocPath(Trim(basePath), True) sBPath = Replace(sBPath, "/", "\") sBPath = addTrailSlash(sBPath) sBPath = LCase(sBPath) sCPath = validTLocPath(Trim(pathToCheck), True) sCPath = Replace(sCPath, "/", "\") sCPath = addTrailSlash(sCPath) sCPath = LCase(sCPath) isSubPath = (sBPath = Left(sCPath, Len(sBPath))) End Function Public Function isSamePath(ByVal basePath As String, ByVal pathToCheck As String) As Boolean Dim sBPath As String Dim sCPath As String sBPath = validTLocPath(Trim(basePath), True) sBPath = Replace(sBPath, "/", "\") sBPath = addTrailSlash(sBPath) sBPath = LCase(sBPath) sCPath = validTLocPath(Trim(pathToCheck), True) sCPath = Replace(sCPath, "/", "\") sCPath = addTrailSlash(sCPath) sCPath = LCase(sCPath) isSamePath = (sBPath = sCPath) End Function
ثانياً يتم إضافة الكود التالي الي المديول (awsReg_User_Trusted_Helper_MOD)
Public Function isCurrentLocTrusted(Optional ByVal sPathToCheck As String = "") Dim currentLoc As String Dim i As Long On Error GoTo ErrorHandler resetUserTrusted loadUserTrusted If userDeleteLoc Is Nothing Then Err.Raise vbObjectError + 1001, "isCurrentLocTrusted", "Unable to load user trusted locations or there are none available." End If If Len(Trim(sPathToCheck)) > 0 Then currentLoc = Trim(sPathToCheck) Else currentLoc = GetAppPath() End If For i = 1 To userKeysCount If isSamePath(CStr(userDeleteLoc(i)("locPath")), currentLoc) Then isCurrentLocTrusted = True MsgLog "This Path: [" & currentLoc & "] Is Trusted", llinfo, devDebugP, usrMsgLog Exit For Else If isSubPath(CStr(userDeleteLoc(i)("locPath")), currentLoc) And userDeleteLoc(i)("allowSub") = True Then isCurrentLocTrusted = True MsgLog "This Sub Path: [" & currentLoc & "] Is Trusted", llinfo, devDebugP, usrMsgLog Exit For Else isCurrentLocTrusted = False End If End If Next i ExitAndClean: resetUserTrusted Exit Function ErrorHandler: MsgLog "We Received an Error" & vbCrLf & _ "Error Number : " & Err.Number & vbCrLf & _ "Description : " & Err.Description & vbCrLf & _ "Source : " & Err.Source, _ llCritical, debugState, usrMsgLog isCurrentLocTrusted = False Resume ExitAndClean End Function
-
2
-
-
أرفق لكم تعديل بسيط حتي يسمح بإضافة مسار كهذا %USERPROFILE%\Desktop\AWSTRUSTLOCATION5\
فكان هدفي من البداية هو توحيد المسارات حتي أستطيع المقارنة
ولكن وجدت ان هذا يمنع من تسجيل مسارات في صورتها المتغيرة والقابلة للتمدد وقد يحتاج إليها البعض
كما تم إضافة تعديل إذا لفرض حفظ المسار وان لم يكن قابل للتمدد ويكون نوع البيانات الخاصة به هو REG_EXPAND_SZ
قد تحتاج إليها في المسارات القصيرة مثل "C:\PROGRA~1" وهو ما يسمي بـ 8.3 Paths
ولكي تحصل علي مساراتك الخاصة بعد فتح الـ CMD في الموقع المراد هذا هو الأمر Dir /x
وهذا التعديل الذي يسمح بتسجل النص بدلاً من REG_SZ إلي REG_EXPAND_SZ
تم أولاً علي الـ awsReg Class Module
1- تم إضافة الكود التالي بالاعلي
Private Const FORCE_EXPAND_SZ As String = "awsExpand "Private Const FORCE_EXPAND_SZ As String = "awsExpand "
2- تم التعديل علي VALUE LET PROPERTY
بإضافة هذا الجزء
ElseIf Left$(CStr(vData), Len(FORCE_EXPAND_SZ)) = FORCE_EXPAND_SZ Then vData = Mid$(vData, Len(FORCE_EXPAND_SZ) + 1) Call RegSetValueEx(hCurKey, ValueName, 0, _ REG_EXPAND_SZ, ByVal CStr(vData), _ Len(vData) + 1)
وهنا يتحقق من النص إذا كان يبدأ بـ "awsExpand " سيتم حذفها وتسجيل النص بنوع REG_EXPAND_SZ
ثم تم التعديل علي
Public Function setUserAppTrustLocation(Optional ByVal locationName As String = "", _ Optional ByVal locationPath As String = "", _ Optional ByVal sDescription As String = "", _ Optional allowSubFolders As Boolean = False, _ -----> Optional forcePathExpandEZ As Boolean = False) As Boolean If forcePathExpandEZ = False Then .value("Path") = sPath Else .value("Path") = "awsExpand " & sPath End If
بعد التجربة :
تم تسجيل ShortPath بنوع REG_SZ وتم التعرف عليه والتعامل معه بدون مشاكل
ما يميز REG_EXPAND_SZ هو تعاملها مع مسارات النظام مثل (%ProgramFiles% - %SystemRoot%)-
2
-
-
السلام عليكم ورحمة الله وبركاته
في هذا الإصدار يوجد ثلاث تطبيقات ( الملف بالمرفقات )
- awsReg_Colorize_VBE لتلوين محرر الأكواد
- awsReg_HyperLink_Warning لتفعيل وتعطيل [ application.FollowHyperlink warning ]
تم شرح وإضافة الأكواد بالمشاركة التالية بالموضوع الأول الرابط من هنا
- awsReg_User_Trusted_Helper_MOD للتحكم بالمواقع الموثوقة Trusted Locations
التطبيق الأول : تلوين محرر الأكواد
يوجد بعض الأدوات المجانية التي تتيح التعديل علي ألوان محرر الأكواد وتعتمد فكرتها علي التعديل في ملف الـ VBA{Ver}.dll
مثال : https://github.com/gallaux/VBEThemeColorEditor
ولكن يمكن تحقق نفس النتيجة يدوي او من خلال إضافة قيم للريجيستري
يدوي :
عن طريق الأكواد
إضافة القيم التالية للريجيستري في المسار (HKEY_CURRENT_USER\Software\Microsoft\VBA\7.1\Common)
7.1 هو رقم الاصدار وقد يختلف وتم إضافة المسارات المتوقعة بالاكواد
CodeForeColors | CodeBackColors | FontFace | FontHeight | FontCharSet
طريقة الإستخدام :call setUpVbeColors(awsDark3)
ملحوظة :
عند اختيار الخط يفضل اختار ما يدعم اللغة العربية إذا كنت تريد إضافة تعليقات باللغة العربية كما يجب التاكد من الأحجام المتاحة فبعض الخطوط تتيح أحجام محددة
مثال
بانتظار مشاركة إبداعتكم
التطبيق الثالث : إضافة مسار البرامج الخاصة بك في المواقع الموثوقة Trusted Locations
لماذا يفضل إضافة المسار الخاص ببرنامجك إلي المواقع الموثوقة ؟
1- الحد من ظهور التحذيرات أثناء عمل البرنامج وعند كل تشغيل
2- والأهم هي سرعة عمل الأكود فوفق دراسة قام بها بعض المبرمجين فإن الأكود تعمل بشكل أسعر يصل إلي 23×
رابط المصدر من هنا
اقتباس من المصدر :اقتباسThis particular issue was brought to my attention by Aleksander Wojtasz, an experienced Access developer from Poland.
Aleksander has some very impressive Access applications involving the use of drag & drop with Gantt charts . See his YouTube channel.
Aleksander also provided sample code to demonstrate the issue which I have adapted (with his permission) for use in the example app supplied with this article.
These are the results I obtained with the example app:
The code ran in about 32 milliseconds from a trusted location but took about 740 milliseconds from an untrusted location. That is about 23x slower!
هل يوجد مكان واحد للإضافة ؟
لا يوجد أكثر من مكان للضافة ولكل مكان ميزاته وعيوبة
مثال : فالمسار الخاص بإضافة المواقع الموثوقة لكل برنامج من برامج الاوفيس هو
Software\Microsoft\Office\16.0\Access\Security\Trusted Locations ويتغير اسم البرنامج ورقم الإصدار وفق النسخة والبرنامج المستهدف
فإذا كان الجذر (ROOT ) هو [ HKEY_CURRENT_USER ] فمن يتأثر بهذه المواقع هو اليوزر الحالي فقط
ولكن إن كان [ HKEY_LOCAL_MACHINE] فيتأثر جميع المستخدمين
كما ان هناك ترتيب فالموقع داخل HKEY_CURRENT_USER له الأفضلية علي HKEY_CURRENT_USER
الموقع الموثوق عبارة عن مفتاح وهو اسم الموقع ويوجد بداخل قيم
ويوجد تحت المفتاح الرئيس [Trusted Locations] قيم
مثال[USER Trusted Locations Values] : HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations --------------------------------------------- [Value Name ] : AllLocationsDisabled [Value Data ] : False [Value Type ] : REG_DWORD [Value Integer] : 0 [Note ] : All Trusted Locations are Allowed --------------------------------------------- [Value Name ] : AllowNetworkLocations [Value Data ] : False [Value Type ] : REG_DWORD [Value Integer] : 0 [Note ] : All NetWork Locations are Disabled --------------------------------------------- [Locations] : HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations\awsTLocation --------------------------------------------- [Location Name ] : awsTLocation [Location Number] : 02 [Location Values] : [Value Name ] : Path [Value Data ] : D:\AWSTRUSTLOCATION3\ [Value Type ] : REG_SZ ----------------------------------- [Value Name ] : Description [Value Data ] : This Location Has Been Trusted By : AWS REG [Value Type ] : REG_SZ ----------------------------------- [Value Name ] : Date [Value Data ] : 17/11/2024/ 10:41:00 AM [Value Type ] : REG_SZ ----------------------------------- [Value Name ] : AllowSubfolders [Value Data ] : True [Value Type ] : REG_DWORD [Value Integer] : 1 [Note ] : All Sub Folders are Allowed ----------------------------------- ---------------------------------------------فإذا تم تفعيل القيمة [AllLocationsDisabled] تحت المفتاح [Trusted Locations]
فهذا يعني تعطيل جميع المسارات الموثوقة
تحذير هام:
أنصح بعدم وضع المسارات شائعة الاستخدم كسطح المكتب والتنزيلات حتي لا نضعف حماية النظام
ملحوظة: أكبر عدد مسموح به للإضافة هو 20 لكل برنامج أوفيس
الأمثلة موجودة في مديول : awsReg_Trusted_Locations
كما يوجد شرح أيضاً في راس المديول : awsReg_User_Trusted_Helper_MOD
تم إضافة تعديل علي الكلاس مديول بإضافة دالة جديدة : allValuesKeysDictColl
-------------------------------------------------------------------------------------------أود الإشارة إلي هذه المقاطع داخل الأكواد لأهميتها
1- داخل الكود loadUserTrusted
في هذا الجزء يتم إضافة المسارات الموجودة إلي قاموس ليتم التحقق منها لاحقاً
وعلية قد يكون هناك مسار مكرر داخل مفاتيح باسماء مختلفة ولذلك أقوم بحذف الموقع الموثق صاحب المسار المكرر
هكذا عالجت الأمر وفق تصوري
2- داخل الكود setUserAppTrustLocation
تم تعليق هذا الجزء من الكود لعدم إحتياجي له ويمكنك تفعيله إذا كنت ترد ظهور رسالة في حال تم إيجاد اسم الموقع
فإذا اجبت بنعم سيتم تغير المسار داخل الموقع الموجود
وإذا أجبت بلا سيتم إضافة _1 لإسم الموقع وإضافة موقع جديد-------------------------------------------------------------------------------------------
يسعدني الإجابة علي استفسارتكم
الأكواد متاح للجميع للتعديل والإضافات
بالتوفيق-
2
-
2
-
-
أخي الكريم @Foksh شكراً لك علي النصيحة
بارك الله فيك
أخي الكريم @Moosak
أشكرك لك مرورك الطيب
كنت بالفعل أنوي تجهيز الأكواد ومشاركتها بمواضيع منفصة ليسهل البحث عنها
ولكن تفضل الأكواد التالية للنقطة 1 وإن شاء الله قريباً النقطة 2روابط للمراجعة :
- https://learn.microsoft.com/en-us/microsoft-365/troubleshoot/administration/enable-disable-hyperlink-warning
- https://www.slipstick.com/how-to-outlook/disable-unsafe-hyperlink-warning-opening-attachments/
الأكواد بالموديول هي:
* hyperLinkWOn - لتفعيل إشعارات الحماية
* hyperLinkWOff - لتعطيل إشعارات الحماية
* isHyperLinkW - إذا كانت القيمة DisableHyperlinkWarning موجودة بالمسار وتساوي 0 او غير موجودة فهذا يعني ان الحماية مفعلة
* msOfficeSecurityPath - لتعود بالمسار المطلوب داخل الريجيستري
* awsLink - يقوم هذا الإجراء بتعطيل الحماية ومن ثم فتح الرابط ثم إعادة تفعيلها مرة أخري
قمت بالامر هكذا حتي لا نترك الحماية معطلة ولكن يمكن التعديل علي الكود بحيث يتعرف اولاً علي حالة الحماية وإعادتها لحالتها بعد الإنتهاء
Option Compare Database Option Explicit Private Const debugState As Boolean = True Private Const msgLogState As Boolean = False Sub Test_awsLink() Dim sPath As String On Error GoTo ErrorHandler sPath = "whatsapp://send/?phone=+2012312313" ' Fisrt Test When The Warning is Enabled hyperLinkWOn ' Make Sure it's Enable Call Application.FollowHyperlink(sPath) ' Second Test When The awsLink it Automatically turnOff then follow The link Then turnOn Again awsLink sPath ExitAndClean: Exit Sub ErrorHandler: MsgLog "We Received an unknown Error" & vbCrLf & _ "Error Number : " & Err.Number & vbCrLf & _ "Description : " & Err.Description _ , llCritical, debugState, msgLogState, "Unknown Error" Resume ExitAndClean End Sub Public Sub awsLink(ByVal sLink As String) Dim msgRes As VbMsgBoxResult On Error GoTo ErrorHandler hyperLinkWOff ' To Disable The Hyper Link Security Warning If Not (isHyperLinkW) Then Call Application.FollowHyperlink(sLink) Else msgRes = MsgLog("Something Went Wrong" & vbCrLf & _ "We are unable To Disable The Hyper Link Security Warning" & vbCrLf & _ "Do You Want to Continue ?", llQuestion, debugState, msgLogState, , , mbYesNo, db2Second, SecToMs(15)) If msgRes = vbNo Then GoTo ExitAndClean Else Call Application.FollowHyperlink(sLink) End If End If hyperLinkWOn ' To Enable The Hyper Link Security Warning ExitAndClean: Exit Sub ErrorHandler: MsgLog "We Received an unknown Error" & vbCrLf & _ "Error Number : " & Err.Number & vbCrLf & _ "Description : " & Err.Description _ , llCritical, debugState, msgLogState, "Unknown Error" Resume ExitAndClean End Sub Public Sub hyperLinkWOn() Dim winReg As awsReg Dim sPath As String Dim sValue As String Dim vResult As Variant On Error GoTo ErrorHandler sPath = msOfficeSecurityPath Set winReg = New awsReg With winReg .useDebug = debugState .useMsgLog = msgLogState .MsgLanguage = englishMsg .Root = HKEY_CURRENT_USER .key = sPath .value("DisableHyperlinkWarning") = CInt(0) End With ExitAndClean: If Not winReg Is Nothing Then Set winReg = Nothing Exit Sub ErrorHandler: MsgLog "We Received an unknown Error" & vbCrLf & _ "Error Number : " & Err.Number & vbCrLf & _ "Description : " & Err.Description _ , llCritical, debugState, msgLogState, "Unknown Error" Resume ExitAndClean End Sub Public Sub hyperLinkWOff() Dim winReg As awsReg Dim sPath As String Dim sValue As String Dim vResult As Variant On Error GoTo ErrorHandler sPath = msOfficeSecurityPath Set winReg = New awsReg With winReg .useDebug = debugState .useMsgLog = msgLogState .MsgLanguage = englishMsg .Root = HKEY_CURRENT_USER .key = sPath .value("DisableHyperlinkWarning") = CInt(1) End With ExitAndClean: If Not winReg Is Nothing Then Set winReg = Nothing Exit Sub ErrorHandler: MsgLog "We Received an unknown Error" & vbCrLf & _ "Error Number : " & Err.Number & vbCrLf & _ "Description : " & Err.Description _ , llCritical, debugState, msgLogState, "Unknown Error" Resume ExitAndClean End Sub ' isHyperLinkW return True if the DisableHyperlinkWarning is not Exist or = 0 Public Function isHyperLinkW() As Boolean Dim winReg As awsReg Dim sPath As String Dim vResult As Variant On Error GoTo ErrorHandler sPath = msOfficeSecurityPath Set winReg = New awsReg With winReg .useDebug = debugState .useMsgLog = msgLogState .MsgLanguage = englishMsg .Root = HKEY_CURRENT_USER If Not (.IsKeyExists(sPath)) Then GoTo ExitAndClean .key = sPath If .IsValueExists("DisableHyperlinkWarning") = True Then vResult = .value("DisableHyperlinkWarning") ' Debug.Print vResult(0) ' Debug.Print vResult(1) ' Debug.Print CBool(vResult(0)) If CInt(vResult(0)) = 0 Then isHyperLinkW = True Else isHyperLinkW = False End If Else isHyperLinkW = True End If End With ExitAndClean: If Not winReg Is Nothing Then Set winReg = Nothing Exit Function ErrorHandler: MsgLog "We Received an unknown Error" & vbCrLf & _ "Error Number : " & Err.Number & vbCrLf & _ "Description : " & Err.Description & vbCrLf & _ "Source : " & Err.Source _ , llCritical, debugState, msgLogState, "Unknown Error" Resume ExitAndClean End Function Public Function msOfficeSecurityPath() As String msOfficeSecurityPath = "Software\Microsoft\Office" & "\" & MsAccessVersion() & "\Common\Security" End Function Private Function MsAccessVersion() As String Dim ver As String ver = Application.Version Select Case Left$(ver, 2) Case "16" MsAccessVersion = "16.0" ' Access 2016/2019/365 Case "15" MsAccessVersion = "15.0" ' Access 2013 Case "14" MsAccessVersion = "14.0" ' Access 2010 Case "12" MsAccessVersion = "12.0" ' Access 2007 Case Else MsAccessVersion = ver End Select End Function
-
2
-
-
سلام الله ورحمتهُ وبركاتهُ علي من أتبع خير الأنام محمد "صلى الله عليه وسلم"
الأخوة الكرام
تحية طيبة وبعد ،،،
أشكر مروركم الكريم وتفاعلكم الطيب
أخي الكريم @Fokshفي 8/11/2024 at 09:54, Foksh said:ليست الفكرة ان نقوم بإنشاء أكواد فقط
مشاركة الأفكار والأكواد فقط.
- قد لا يتسع الوقت والجهد لعمل موضوع متكامل الأركان [ قدر المستطاع ]
فأفضل المشاركة ثم متابعة الموضوع بالأمثلة او بالرد علي الاستفسارات لأسباب كثيرة أهمها
* قد يكمل الموضوع من هو أفضل منك [ - من الناشر - ]
* قد تجد في الاستفسارات او الإقتراحات ما يدفعك إلي التعديل ( الجذري او الجزئي)
* التأجيل قد يتيح الفرصة للتراخي والتكاسل والوساوس ( يحدث في كثير من الأحيان ) اللهم أعذنا
* قد لا يستفيد أحد من الفكرة وخاصةً أنها ليست جديدة والجميع لديه ما يحقق المراد ولكن
- قد يستفيد أحد من طريقة كتابة الأكواد او التفاصيل الصغيرة او وظيفية داعمة
- قد يجيد غيرك التفكير ويثري الموضوع بتعديلات او أمثلة لم تخطر علي بالكفي 8/11/2024 at 09:54, Foksh said:بل دعمها بأفكار تنفيذية حتى يثبت الموضوع جدارته في ما هو قادر على فعله
إن أستطاع ( الناشر ) فهو خير
وأنصح أن يحشد ما يستطيع من النواية الحسنة الطيبة
وأسأل الله لنا الإخلاص في القول والعمل و التوفيق والسدادفي 8/11/2024 at 09:54, Foksh said:هل تستطيع من خلال الكود التعرف على البرامج المثبتة على الكمبيوتر
قبل طرح للسؤال لم أكن أعلم بكل ما يلزم وبعد بحث الحمد لله فهمت أن الأمر ليس صعباً
هل انت بحاجة فأجتهد في تحقيق مرادك ؟ -
أخي الكريم @Foksh
الأخوة الكرام صبحكم الله بالخير
1- إلغاء وتفعيل الحماية الخاصة بـ application.FollowHyperlink2- إضافة مسار البرنامج لـالــ Access\Security\Trusted Locations
3- يعتبر الرجستري وسيط بين الوجهات المتعددة
مثال 1 :
أعمل بكود لضبط وتحجيم أبعاد الاكسيس والتعامل مع أكثر من شاشة
بحيث يسمح للمستخدم بعرض البرنامج علي الشاشة 1 او 2 إن كان متصل بالجهاز أكثر من شاشة
وإن كانت الابعاد مختلفة تختلف أبعاد البرنامج وهو يعتمد علي الجداول بشكل أساسي
وإن كان هناك أكثر من واجهة تحتاج إلي تطبيق الامر علي كل واجهة
ولكن الريجيستري يعتبر وسيط يسمح لك بتمرير القيم وإستدعائها وتعين قيم افتراضيةمثال 2 :
يمكن إستخدامة في حماية البرنامج الخاص بك فإضافة قيم في الريجيستري تسمح لك بالتحقق من
- متي أول مرة تم إستخدام البرنامج (للمدة التجريبة)
- إضافة مفاتيح خاصة بكل جهاز
- الأفكار كثيرة
أظن كدا فكرة الوساطة واضحة وأتمني أسمع أفكاركم 🧠4- إستدعاء بعض المعلومات التي تحتاج إليها مثل
- معرفة مسار النظام الافتراضي [ HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion ]
- معرفة جميع الطابعات الموجودة [ HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Print\Printers ]
- معرفة الطابعة الإفتراضية [ HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows ] ثم [ Device ]
5 - تغير الإعدادات
- تغير الطابعة الإفتراضية
- عدم السماح للوندوز بتجاوز إختيار
- فيما أذكر يمكن التحكم بالطابعة الإفتراضية من خلال الريجيستري
كعمل بروفايل خاص بإعدادات خاصة
أرجو لكم التوفيق والسداد والتعامل مع الريجيستري بحذر ويفضل دائماً أخذ نسخة احتياطية للأمان-
2
-
1
-
-
السلام عليكم ورحمة الله وبركاته
الأخوة الكرام بارك الله فيكم
تجدون بالملف المرفق قاعدة بيانات بها
- [ awsReg ] وهو Class Module للتحكم بالريجيستري [ Windows Registry ]
- [ awsReg_Test_Module ] وهو مديول به نماذج لتوضيح كيفية للإستخدام
حاولت قدر المستطاع تغطية جميع الإستخدامات- [ باقي المديولز ] هي ضرورية للعمل
نبذة مختصرة
- مصدر الكود من هنا :
https://learn.microsoft.com/en-us/previous-versions/office/developer/office2000/aa155731(v=office.10)?redirectedfrom=MSDN&ref=nolongerset.com
- من قام بتعديل التعريفات لتناسب 64x من هنا :
https://nolongerset.com/regop-class-for-64-bit-vba/
- قمت بفضل الله ونعمتة ( الحمد كله لله أوله وأخره)
1- دمج وتجهيز الكود بالكامل 😁
2- تعديل نظام عرض الرسائل والأخصاء بالكامل يدعم اللغة ( العربية - الإنجليزية )
3- تعديل وظيفة allValue لتعود بي 3D Array القيمة والبيانات ونوعها
4- تعديل وظيفة value لتعود بي 2D array البيانات ونوعها
5- إضافة وظيفة allKeysDict - [Get Property] لتعود بالمفاتيح الفرعية داخل قاموس
6- إضافة وظيفة allValuesDict - [Get Property] لتعود بالقيم الموجودة في مفتاح داخل قاموس
7- إضافة وظيفة IsKeyExists لتعود بنعم إذا كان المفتاح موجود (تم إضافة الـ Api الخاص بها)
8- إضافة وظيفة IsValueExists لتعود بنعم إذا كانت القيمة موجودة
9- التعديل علي بعض الأكواد وإضافة وظائف أخري (قد نأتي لذكرها لاحقاً "إن شاء الله"شرح لمثال واحد [ كتابة قيم داخل الريجيستري ]
باقي الأمثلة موجودة بالملف
Public Sub Test_awsReg_WriteValues() Dim winReg As awsReg Dim sPath As String Dim sValue As String Dim vResult As Variant On Error GoTo ErrorHandler sPath = "Software\awsApp" ' awsApp Doesn't Exist Yet Set winReg = New awsReg With winReg .useDebug = debugState .useMsgLog = msgLogState .MsgLanguage = englishMsg .Root = HKEY_CURRENT_USER .key = sPath ' REG_SZ Writing a string value .value("MyString") = "Hello, World!" .value("Date") = Format(Now, "yyyy-mm-dd hh:nn:ss") .value("awsPath") = "%USERPROFILE%\Documents" ' REG_DWORD Writing a numeric value [0 For False] [1 For True] .value("isValid") = CInt(1) .value("myNumber") = 2341 .Options = StoreNumbersAsStrings 'this to store numbers as String .value("strNumer") = 5246 ' REG_MULTI_SZ Writing an array (multi-string value) Dim myArray(2) As String myArray(0) = "Value1" myArray(1) = "Value2" myArray(2) = "Value3" .value("MyArray") = myArray Debug.Print "Values written successfully" End With ExitAndClean: If Not winReg Is Nothing Then Set winReg = Nothing Exit Sub ErrorHandler: MsgLog "We Received an unknown Error" & vbCrLf & _ "Error Number : " & Err.Number & vbCrLf & _ "Description : " & Err.description _ , llCritical, debugState, msgLogState, "Unknown Error" Resume ExitAndClean End Sub
النتيجة :
الأخوة الكرام الكود متاح للجميع نسعد بتعديلاتكم ومشاركتكم وإستفساركم
بالتوفيق-
3
-
تصحيح كود
في قسم الأكسيس Access
قام بنشر
السلام عليكم ورحمة الله وبركاته
أخي الكريم
فضلاً جرب الكود القديم من القاعدة المرفقة
القاعدة 3_V1.zip