ابو جودي

.

ومشاركة مع اساتذتى الكرام يا استاذ @عبد اللطيف سلوم افتح التصميم ان استطعت واخبرنى ان نجحت My Securty.zip

تم الحل المشكلة كانت بتجميع الازرار ولكن لابد من اعادة النظر فى اماكن الازرار تبعا للصلاحيات وشئ من اتنين 1 تكون قادر تعمل 2 تنتظر @د.كاف يار لان أهل مكة ادرى بشعابها لان انا بصراحة صدعت بقالى يومين اخبط راسى بالحيط وابحث عن مشكلة برمجية بالاكواد وبصراحة فى الوقت الحالى مش قادر افكر تانى الدائن و المدين.zip

اتفضل قم بالاطلاع على المرفق الاتى يتم وضع الروتين العام فى موديول ويتم استدعاءه من خلال اسمه حسب الحاجة كالاتى getMyIP() GetLocalIP.mdb

اتفضل Public Function getMyIP() Dim myWMI As Object, myobj As Object, itm Set myWMI = GetObject("winmgmts:\\.\root\cimv2") Set myobj = myWMI.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True") For Each itm In myobj getMyIP = itm.IPAddress(0) Exit Function Next End Function

اتفضل توليد سجلات (3).accdb

اتفضل يا سيدى توليد سجلات(2).accdb

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

اتفضل المرفق بثلاث طرق توليد سجلات.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

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

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