ابو جودي

السلام عليكم ورحمة الله تعالى وبركاته بعد جلسات العمل والنقاش هذه وأيضا تلك وأيضا تلك وأيضا تلك واخص فيها أستاذي الجليل ومعلمي القدير و والدى الحبيب أستاذ @ابوخليل له كل الشكر والتقدير وكذلك أصحاب المواضيع الذين حثوا الهمم لإخراج مثل هذا العمل اهداء الى منتدانا الحبيب واحبابنا الكرام اليكم كود الاستجابة السريع QR CODE (يدعم اللغة العربية) حسب متطلبات هيئة الزكاة والضريبة والجمارك السعودية علما انه يتم قراءة الرمز عبر قارىء خاص بالهيئة ( تطبيق جوال ) حمل من هنا : تطبيق هيئة الزكاة والضريبة والجمارك كما يتم قراءة الرمز عبر قارىء خاص من خلال موقع على الانترنت إذهب الى الموقع : من هنا الشرح ... مهم جدا مفيش أي شرح متطلبات التشغيل كالتالي : فقط يرجى التأكد من وجود الأداة qr.exe داخل مجلد باسم Reference في نفس مسار قاعدة البيانات اسالكم الدعاء بظهر الغيب لصديقي في العمل و الذى ساعدني في عمل ملف qr.exe أتمنى لكم تجربة ممتعة ... ================================================== KSA E-Invoicing QR-Code.zip

وبفضل الله تعالى هذا المرفق الاخير يمكن تجربة مسح الqrcode من هنا لقراءة البيانات منه https://aliphia.com/zatca-qrcode/#scan-using-file E-Invoicing.zip

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

جرب الاتى ولاخظ انك تختار اسم ومكان كل مجلد تحديدا حتى لو 100 مجلد او اكثر MD("D:\Officena\Access\VBA\a\b\c\d\e\f\g\h") MD("D:\Officena\Access\VBA\1\2\3\4\5\6\7\8") لو تقصد لازم التعديل من الكود فقط اقول لك لا اعمل جدول واعمل الدالة DLookup لتكون بذلك الشكل MD(DLookup("[FldName]","tblName")) وفى الجدول اكتب المسار الذى تريده طبعا ممكن تعمل معيار للدالة لاختيار حقل محدد وتسطيع عمل loop على كل سجلات الجدول لينشئ كل المجلدات بجانب او داخل بعضها او فى اماكن متفرقة دفعة واحدة بضغطة زر اذا كيف لا يتيح مرونة

اتفضل MdiaPlayer.zip

لازم رقم قومى مضبوط يا دكتور طبعا جرب الرقم ده يا دكتور 31710180101875 31407030101341

اعمل ضغط واصلاح للقاعدة اضغط القاعدة باى برنامج مثل winrar لو مازال الحجم كبيرا ارفعها على ميديا فاير او top4top وضع رابط الملف

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

لا شكر على واجب زكاة العلم نشره وانا اقل طالب علم فى خذا الصرح الشامخ

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

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

يا دكتور @الحلبي انا في انتظار حضرتك تأتيني بالرقم القوم هنا

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

وهذا المرفق حتى تكون الاجابة بعد السؤال وباستفاضة وهذا مرفق تم فيه ايقاف عمل زر الـ TAP كذلك تم ايقاف الاتى النسخ من خلال الازرار Ctrl+C القص من خلال الازرار Ctrl+X اللصق من خلال الازرار Ctrl+V فتح محرر الأكواد من خلال الضغط على الازرار Alt+F11 هذا على سبيل المثال وليس الحصر Disabling Tab key.mdb

على كل حال سواء قمت بالتجربة وتوصلت لما تريد او لا زيادة فى الخير اليكم الطريقة البرمجية ضع السطر التالى فى حدث Form_Load KeyPreview = True لتفعيل الزر نعتمد فى الكود الاتى على امرين رئيسيين رقم الزر رقم مفتاح الشيفت وما هو استخدام رقم الزر ورقم الشفت ؟ | رقم الشفت اذا كان = 0 يتم تعطيل عمل المفتاح واذا كان رقم الشفت= 1 يعمل المفتاح مرة اخرى والرقم الخاص بزر TAP هو 9 لذلك ان اردنا تعطيله نستخدم الكود الاتى فى الحدث Form_KeyDown مع المتغير الثانى وهو رقم مفتاح الشيفت = 0 Select Case KeyCode Case 9 KeyCode = 0 MsgBox "Tab Cancelled" End Select طيب لو اردنا تفعيله رقم مفتاح الشيفت = 1 Select Case KeyCode Case 9 KeyCode = 1 MsgBox "Tab Cancelled" End Select طيب من اين علمنا رقم الزر هناك طريقتان من هلال القاعدة التى سوف اقوم بوضعها كمرفق او من خلال الموقع الاتى https://docs.microsoft.com/en-us/previous-versions/visualstudio/visual-basic-6/aa243025(v=vs.60)?redirectedfrom=MSDN ملاحظة ممكن استخدام رقم الزر او الاسم الثابت للزر وتحصل على الاسم من الموقع من Constant Key Code Constants.zip

وممكن من خلال كود بس جرب دى الاول

وبما ان الحديث عن الرقم القومى ولتكتمل الفائدة هذا المرفق هدية ID NATIONALITY (2).mdb

وانا كذلك أضم صوتي إلى أصواتكم بالشكر والامتنان للـ @د.كاف يار لمجهوده المميز ومبادرته دائما في الرد على التساؤلات وتقديم يد العون دائما وابدا كحال كل اساتذتنا الكرام جزاهم الله خيرا شكرا لك @د.كاف يار انت وكل معلمينا الافاضل وشكر الله لكم

اتفضل يا سيدى ID NATIONALITY.mdb

فى الروتين الاتى قمت بطباعة كل نتيجة من خلال الامر Debug.Print عدد مرات الطباعة من خلال الامر Debug.Print 14 مرة السؤال هو كيف يمكننا الخصول مثلا على النتيجة التى تخص Debug.Print digits(8 - 1) فقط Function SplitLong() Dim digits() As Long Dim intValue As String Dim i As Long Dim strValue As String intValue = "28202280101112" strValue = intValue ReDim digits(Len(strValue) - 1) As Long For i = 1 To Len(strValue) digits(i - 1) = Mid$(strValue, i, 1) Next Debug.Print " 1 >---->> "; digits(1 - 1) Debug.Print " 2 >---->> "; digits(2 - 1) Debug.Print " 3 >---->> "; digits(3 - 1) Debug.Print " 4 >---->> "; digits(4 - 1) Debug.Print " 5 >---->> "; digits(5 - 1) Debug.Print " 6 >---->> "; digits(6 - 1) Debug.Print " 7 >---->> "; digits(7 - 1) Debug.Print " 8 >---->> "; digits(8 - 1) Debug.Print " 9 >---->> "; digits(9 - 1) Debug.Print " 10 >---->> "; digits(10 - 1) Debug.Print " 14 >---->> "; digits(11 - 1) Debug.Print " 12 >---->> "; digits(12 - 1) Debug.Print " 13 >---->> "; digits(13 - 1) Debug.Print " 14 >---->> "; digits(14 - 1) End Function

على كل فى الاستعلام قم بوضع الدالة الاتية مع تغيير FldName باسم الحقل الذى يحتوى على الرقم القومى Mid([FldName],1,1) الرقم الثانى Mid([FldName],2,1) الرقم الثالث Mid([FldName],3,1) وانت كمل .....

وعليكم السلام ممكن اعرف السبب لان ده طلب غريب بصراحة

حلو التفكير بره الصندوق الفكرة ممتازة بس سبب ترددى فى وضع الكود لو الاكسس عللق كما يحدث احيانا ولم يتم مسح ملف الاكسل وكنت لسه بافكر وادورها براسى وحضرتك ما شاء الله وضعت الحل

بضحك لأنى كنت ناوى أقول جرب الكود هذا وكنت متردد Dim fso As New FileSystemObject Dim strDesktopPath As String: strDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") If fso.FolderExists(strDesktopPath & "\Folder2") Then: Else: fso.CreateFolder (strDesktopPath & "\Folder2") DoCmd.RunSavedImportExport "export" Dim ExceToLocC As String: ExceToLocC = "C:\Table1.xlsx" Dim ExcelCopy As String: ExcelCopy = strDesktopPath & "\Folder2\Table1.xlsx" FileCopy ExceToLocC, ExcelCopy: Kill ("C:\Table1.xlsx")

انت مش مشكلتك فى مسار سطح المكتب انت مشكلتك فى طريقة التصدير الغريبة بتاعتك وده مش تصدير دا امر نسخ وبصراحة انا مش فاهمه شغال ازاى ومن فين ضبط كودك او ابحث Dim fso As New FileSystemObject Dim strDesktopPath As String: strDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") If fso.FolderExists(strDesktopPath & "\Folder2") Then Else fso.CreateFolder (strDesktopPath & "\Folder2") End If DoCmd.RunSavedImportExport "export" Dim strExportPath As String: strExportPath = strDesktopPath & "\Folder2\Table1.xlsx" fso.CopyFile strExportPath, True