ابو جودي

اووووووووووف الان بعد كل هذا العناء😡 تحصلت على ملف من موقع طبعة المصحف الشريف جااااااااااهز 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

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

لاحظت ان قاعدة البيانات التى تعمل من خلال تمرير البيانات الى ملف تنفيذى والذى تم انشاءه من خلال الفيجوال دوت نت العمل بطئ نظرا لارسال البيانات واستقبال الكود المشفر من ملف نصى دوال الـ API احدثت مشاكل كع نسخة اوقيس 2007 وبالرغم من التعديل والتجربة بنجاح الا انه اصناء التعديل تم ملاحظة ان الانتى فايروس يحذف الملف التنفيذى ولما سبق تم بفضل الله سبحانه وبحمده تعديل المرفق ليعمل من خلال مكتبات الجافا بدون اى برامج خارجية كل الاكواد من خلال الاكسس فقط وبدون استخدام دوال الـ API فى انتظار ردكم بعد التجارب E-Invoicing.zip

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

اهلا بك .. لا شكر على واجب

انظر الى المرفق test (2) (1).accdb

الاستعلام يعمل بنجاح ما فى اى مشاكل السؤال هو متى تريد ان يتم تشغيل الاستعلام ؟

اكمل باقى الاستعلام كما تريد بنفس الكيفية التى بدأتها لك test (2).zip

السلام عليكم يا استاذى الفاضل .. لو تكرمت ممكن الموضوع الرئيسي اللى حضرتك طبقت منه نظام الصلاحيات او المرفق الاصلى الذى يعمل بدون اى مشاكل

اتفضل za-AKSAT-Pro-LAST- (1).mdb

ومع تجربة الرقم الاتى تكون نتيجة خطأ - تاريخ الميلاد 82 1008229010391300 وفكرتى فى حدث فتح النموذج Dim rst As dao.Recordset Dim inc As Long Set rst = CurrentDb.OpenRecordset("SELECT جدول1.* FROM جدول1;") rst.MoveFirst Do Until rst.EOF If Mid(rst![رقم _التعريف _الوطني], 4, 2) > Format(Date, "yy") Then inc = "19" & Mid(rst![رقم _التعريف _الوطني], 4, 2) ElseIf Mid(rst![رقم _التعريف _الوطني], 4, 2) <= Format(Date, "yy") Then inc = "20" & Mid(rst![رقم _التعريف _الوطني], 4, 2) End If rst.Edit rst!سنة_المبلاد = inc rst.Update rst.MoveNext Loop rst.Close: Set rst = Nothing MsgBox "Done"