ابو جودي

اى طريقة تريد التعديل عليها ؟

اتفضل المرفق بثلاث طرق توليد سجلات.accdb

اتفضل هذا التعديل Public Sub GenrateRecords(ByRef FixedCode As Boolean) Dim rec As Recordset, n As Byte Set rec = CurrentDb.OpenRecordset("CodeGenerator", dbOpenDynaset, dbSeeChanges) With rec For n = txtQTY1 To txtQTY2 .AddNew If Not FixedCode Then !Code = txtCode & n Else !Code = txtCode !DoorType = txtDoorType !Size = txtSize !Handing = txtHanding !HS = txtHS !QTY1 = txtQTY1 !QTY2 = txtQTY2 .Update Next End With End Sub وفى حالة ان الـ Code ثابت استخدم الكود الاتى Call GenrateRecords(True) وفى حالة ان الـ Code متغير ويجمل الرقم التسلسلى استخدم الكود الاتى Call GenrateRecords(False)

تجربة اضافية برجاء فتح نموذج frmReadQR وعمل استعراض لرمز الاستجابة الذى تم انشاءه E-Invoicing.zip

الحل النهائى والامثل لانشاء رمز الاستجابة السريع والمتوافق مع هيئة الزكاة للملكة العربية السعودية بدعم مكتبات الجافا والـ NET Framework 4.7 ميزات القاعدة حمل ملفاتى الهامة داخل القاعدة وبذلك لن يتم فقدانها مطلقا لاى سبب الا بفقد القاعدة نفسها عند نقل القاعدة لاى جهاز يتم وضع الملفات بتحميلها من القاعدة الى الجهاز اليا فى مسار القاعدة فلن يشغل بال المستخدم اى شئ بخصوص ملفات المكتبات عند عدم تسجيل المكتبات يتم ذلك اليا دون ادنى تدخل من المستخدم يتم فتح الملف الدفعى اليا فى حالة عدم تسجيل المكتبات وهو يعيد تشغيل نفسه كمسؤل ويقوم باللازم عند الانتها للملف الدفعى من التسجيل للمكتبات يعيد فتح القاعدة اليا واغلاق نفسه تحميل القاعدة من هنا

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

على كل حال هذه فكرتى ان كنت قد فهمت الموضوع توليد سجلات.accdb

اممممم ايه هو الطريق الثانى 🤔

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

اووووووووووف الان بعد كل هذا العناء😡 تحصلت على ملف من موقع طبعة المصحف الشريف جااااااااااهز hafsData_v18.xlsx

والان اخى الحبيب الاستاذ @Barna اليكم التجربة الاخيرة.... وجارى التيقن من النتيجة Public Function StripSpChars(strString As String) As String If strString & "" = "" Then Exit Function Dim lngCtr As Long Dim intChar As Integer For lngCtr = 1 To Len(strString) intChar = AscW(Mid(strString, lngCtr, 1)) If intChar = 32 Or _ intChar >= 1569 And intChar <= 1594 Or _ intChar >= 1601 And intChar <= 1610 Or _ intChar >= 1648 And intChar <= 1649 Then StripSpChars = StripSpChars & ChrW(intChar) End If Next lngCtr Dim itm As Variant For Each itm In Array(ChrW("1609") & ChrW("1648") & ChrW("32")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1609") & ChrW("32")) Next For Each itm In Array(ChrW("1569") & ChrW("1575")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575")) Next For Each itm In Array(ChrW("1649"), ChrW("1648")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575")) Next For Each itm In Array(ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1581") & ChrW("1605") & ChrW("1575") & ChrW("1606")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1581") & ChrW("1605") & ChrW("1606")) Next For Each itm In Array(ChrW("1584") & ChrW("1575") & ChrW("1604") & ChrW("1603")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1584") & ChrW("1604") & ChrW("1603")) Next For Each itm In Array(ChrW("1575") & ChrW("1604") & ChrW("1589") & ChrW("1604") & ChrW("1608") & ChrW("1575") & ChrW("1577")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575") & ChrW("1604") & ChrW("1589") & ChrW("1604") & ChrW("1575") & ChrW("1577")) Next For Each itm In Array(ChrW("1609") & ChrW("1575")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575")) Next StripSpChars = Trim(StripSpChars) End Function Strip Special Characters.zip

طيب رجاء جرب المرفق الاتى تم تناول التعامل مع تنسيق الوقت بطريقة اخرى وللعلم انا جربته وما بيظهر عندى انه متوافق على تطبيقين لان دفتر مو متوفر ولم اجده على متجر بلاى E-Invoicing.zip

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

فى انتظار ردكم بعد التجربة الان كل شئ صار يتم بدون اى تدخل من المستخدم E-Invoicing.zip

روتين عام يتم تمرير النص اليه ليقوم بعمل تعريه للنص من اى اشكال او رموز او حرف غير الاحرف العربية يعنى نقدر نقول مع هذا الروتين وداعا لكل حركات ورموز التشكيل If strString & "" = "" Then Exit Function Dim lngCtr As Long Dim intChar As Integer For lngCtr = 1 To Len(strString) intChar = AscW(Mid(strString, lngCtr, 1)) If intChar = 32 Or _ intChar >= 1569 And intChar <= 1594 Or _ intChar >= 1601 And intChar <= 1610 Or _ intChar >= 1648 And intChar <= 1649 Then StripSpCharsOnly = StripSpCharsOnly & ChrW(intChar) End If Next lngCtr StripSpCharsOnly = Trim(StripSpCharsOnly) ونفس الروتين مع بعض التعديلات لعمل مصفوفات لاستبدال حركات تشكيل مخصصة Public Function StripSpChars(strString As String) As String If strString & "" = "" Then Exit Function Dim lngCtr As Long Dim intChar As Integer For lngCtr = 1 To Len(strString) intChar = AscW(Mid(strString, lngCtr, 1)) If intChar = 32 Or _ intChar >= 1569 And intChar <= 1594 Or _ intChar >= 1601 And intChar <= 1610 Or _ intChar >= 1648 And intChar <= 1649 Then StripSpChars = StripSpChars & ChrW(intChar) End If Next lngCtr Dim itm As Variant For Each itm In Array(ChrW("1649")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575")) Next For Each itm In Array(ChrW("1648") & ChrW("1604")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575") & ChrW("1604")) Next For Each itm In Array(ChrW("1610") & ChrW("1648")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1610") & ChrW("1575")) Next For Each itm In Array(ChrW("1648")) StripSpChars = Replace(StripSpChars, CStr(itm), "") Next StripSpChars = Trim(StripSpChars) End Function

الفانك بتاعك دع حلو وطبعا شكرا على افكارك ومجهودك اولا ولكن انت اعتمدت على ازالة كل حركة يعنى لو مستقبلا حركة زادت مو عاملين حسابها بالكود راح تضل وما بتنحذف والفانك مكتوب فيه حجات بالعربى تعالى بقى نفكر بالمقلوب ايه رايك فى الفانك ده If strString & "" = "" Then Exit Function Dim lngCtr As Long Dim intChar As Integer For lngCtr = 1 To Len(strString) intChar = AscW(Mid(strString, lngCtr, 1)) If intChar = 32 Or _ intChar >= 1569 And intChar <= 1594 Or _ intChar >= 1601 And intChar <= 1610 Or _ intChar >= 1648 And intChar <= 1649 Then StripSpCharsOnly = StripSpCharsOnly & ChrW(intChar) End If Next lngCtr StripSpCharsOnly = Trim(StripSpCharsOnly) بالطريقة دى اى شئ غير حروف العربى ما راح يظل موجود طيب يبتفضل الحروف اللى بدنا نغيرها الحين راح نستخدم المصفوفات تبع الفانك حقك بس بترتيب معين وبحبة فهلوة Public Function StripSpChars(strString As String) As String If strString & "" = "" Then Exit Function Dim lngCtr As Long Dim intChar As Integer For lngCtr = 1 To Len(strString) intChar = AscW(Mid(strString, lngCtr, 1)) If intChar = 32 Or _ intChar >= 1569 And intChar <= 1594 Or _ intChar >= 1601 And intChar <= 1610 Or _ intChar >= 1648 And intChar <= 1649 Then StripSpChars = StripSpChars & ChrW(intChar) End If Next lngCtr Dim itm As Variant For Each itm In Array(ChrW("1649")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575")) Next For Each itm In Array(ChrW("1648") & ChrW("1604")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575") & ChrW("1604")) Next For Each itm In Array(ChrW("1610") & ChrW("1648")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1610") & ChrW("1575")) Next For Each itm In Array(ChrW("1648")) StripSpChars = Replace(StripSpChars, CStr(itm), "") Next StripSpChars = Trim(StripSpChars) End Function

طيب انا بس اشوف الكود وان شاء الله راح لاقى حل بامر الله

هذا ليس تحريف الله يرضى عليك الفعل (طغى) ومشتقاته يطغى، أطغى..) آخره ألف مقصورة على صورة الياء وفقًا للقاعدة ،فأصل الألف ياءٌ ؛ لأنه من الطغيان . وقد جاء الفعل ومشتقاته على هذا النحو في القرآن الكريم إلا موضعًا واحدًا هو قوله تعالى في الآية الحاديةَ عشْرةَ من سورة الحاقة:" إنَّا لمَّا طغَا الماءُ حملناكُم في الجَاريَة) فرُسِمت الألفُ قائمةً على خلاف قاعدتها،وذلك لتناسُبِ اللفظ مع المعنى؛ فامتدادُ الألف وارتفاعُه هكذا مناسبٌ للصورةِ التعبيرية من طغيان الماء وارتفاعِه ليُغرقَ الكافرين من قوم نوح ، وما كان طغيانُ الماءِ هكذا إلا بإرادة المولى-سبحانه-وقدرتِه،فناسب ارتفاعَ الماءِ ارتفاعُ الألف. أما استعمالُ الفعل( طغى) في بقية المواضع فقد جاء في سياق الحديث عن طغيان البشر،فهو طغيان مَقدورٌ عليه،مُحاطٌ به،مُحبَطٌ أثرُه،فناسبَه رسمُ الألفِ على صورة الياء على أصل القاعدة. والمراد تسهيل استخدام البحث فقط وليس التحريف

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

طيب بالمرة انظر الى الاية رقم 15 سورة البقرة كلمة طُغۡيَٰنِهِمۡ بالمرة لا تنسى تحويل الـ يَٰ الى ا حتى نتمكن عند البحث من كتابة الكلمة بالشكل الاتى طغيانهم وطبعا لن ترسل لى جدول الايات فقط بدون جركات التشكيل اريد الاطلاع على الفكرة والكود المستخدم لا طبعا مو مجانى 😡

بانتظار المرفق

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

ومشاركة مع احبابى وبدون استخدام اى مكتبات يكون الكود كالاتى Dim FD As Object Dim Path As String Set FD = Access.Application.FileDialog(1) FD.AllowMultiSelect = False FD.Filters.Clear If FD.Show = -1 Then Path = FD.SelectedItems(1) Else: Exit Sub End If FollowHyperlink Path

اتفضل ShowHideSideBareRight (2).zip

ان شاء الله اكمل اعتذر نسيت الموضوع لانشغالى