ابو جودي

طيب ايه رايك فى عمل مقارنة سريعة الكود بتاع حضرتك لازم ولابد وحتما انك تستدعى المكتبة ' Requires reference to Microsoft Office 11.0 Object Library. طبعا الرقم 11 سوف يتغير تبعا لاصدار الاوفيس يعنى يحصل مشكلة لو كان ' Requires reference to Microsoft Office 16.0 Object Library. وخيشتغل على اكسس اصدار اقل الكود المستخدم فى السؤال لا يعتمد على مكتبات

طيب يا باش مهندس انا اكتشفت السبب اخيرا فى المشكلة عندى انا كنت فاتح اكثر من قاعدة اعدل على واحدة واجرب على واحدة تانى خالص منشان هيك ما كنت احصل اى نتيجة وشكيت فى نفسي ما انتبهت الا الان وعلى كل جزاكم الله خيرا ولارد بضاعتكم اليكم يا باش مهندس @Eng.Qassim سوف استخدم الكود بهذا الشكل If Nz(strOptionExtension, "") = "" Then .Filters.Add "Select File", "*.*" Else: .Filters.Add "Select File", strOptionExtension

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

السلام عليكم واتتنى فكرة كتابة روتين عام متعدد الخيارات لتكون وظيفته كالاتى احضار مسار ما احضار مسار لملف محدد مع المرونة فى تغيير الامتداد تبعا للاستخدام المطلوب وتوقفت عند محاولة تمرير الامتداد من خلال استخدام المتغير strOptionExtension وتحديد فى هذا السطر المن الكود .Filters.Add "Select File", "*.jpg , *.png" اريد استبدال جزء الامتداد على ان يكون بهذا الشكل .Filters.Add "Select File", strOptionExtension وولاسف فشلت كل محاولاتى Function CustomPicker(Optional ByRef btOptionDialog As Byte = 0, Optional ByRef strOptionExtension As String = "") Dim FileDialog As Object Dim sPath As String Dim sFile As String Select Case Nz(btOptionDialog, 0) 'FilePicker Case Is = 0 Set FileDialog = Access.Application.FileDialog(3) With FileDialog .allowmultiselect = False .Filters.Clear .Filters.Add "Select File", "*.jpg , *.png" If .show = -1 Then .Title = "Please select a File" CustomPicker = .SelectedItems(1) End With 'FolderPicker Case Is = 1 Set FileDialog = Access.Application.FileDialog(4) With FileDialog .allowmultiselect = False .Filters.Clear If .show = -1 Then .Title = "Please select a Folder" CustomPicker = .SelectedItems(1) End With End Select End Function

وهذ الكود ان شاء الله يفى بالغرض كما هو المطلوب Public Function MultiReplacements(Optional ByVal strInput As String = "") As String If Nz(strInput, "") = "" Then Exit Function strInput = Replace(strInput, "ي ", "ى " & "") strInput = Left(strInput, Len(strInput) - 1) + Replace(Right(strInput, 1), "ي", "ى") strInput = Replace(strInput, "ة", "ه" & "") strInput = Replace(strInput, "عبدال", "عبد ال" & "") strInput = Replace(strInput, "عبدرب", "عبد رب" & "") MultiReplacements = strInput End Function وطبعا لتجنب حدوث اى مشاكل بسبب استخدام الاحرف العربية داخل محرر الاكواد افضل استخدام الكود الاتى Public Function MultiReplacements(Optional ByVal strInput As String = "") As String If Nz(strInput, "") = "" Then Exit Function strInput = Replace(strInput, ChrW(1610) & ChrW(32), ChrW(1609) & ChrW(32) & "") strInput = Left(strInput, Len(strInput) - 1) + Replace(Right(strInput, 1), ChrW(1610), ChrW(1609)) strInput = Replace(strInput, ChrW(1577), ChrW(1607) & "") strInput = Replace(strInput, ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1575) & ChrW(1604), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1575) & ChrW(1604) & "") strInput = Replace(strInput, ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1585) & ChrW(1576), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1585) & ChrW(1576) & "") MultiReplacements = strInput End Function

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

طيب اولا اهلا استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل ادامكم الله فوق رؤسنا انت وكل اساتذتنا الكرام لازلت المشكلة قائمة لو كتبنا مثلا احمد العبدان عبد الله نحصل على احمد العبد ان عبد الله يمكننا اضافة بعد التعديلات للحصول على الاسم بدون عدد 2 مسافة لكن عائلة العبدان إن حضرت الينا ماذا نفعل معهم ؟ وحتى لاتزعل منا عائلة العبدان نستخدم هذا الكود Dim i As String Me.txt1.SetFocus i = Me.txt1.Value i = Replace(i, "عبدال", "عبد ال" & "") i = Replace(i, "عبدرب", "عبد رب" & "") Me.txt1 = i

وأخيرا ً بحمد الله الذى تتم بنعمته الصالحات ضع للكود الاتى فى وحدة نمطيه Public Function MultiReplacements(ByVal varInput As String, ParamArray varReplacements() As Variant) On Error GoTo ErrorHandler Dim n As Integer Dim varOutput As Variant Dim intParamsCount As Integer If Nz(varInput, "") = "" Then Exit Function ' varInput = Nz(varInput, 0) 'If Not IsNull(varInput) Then If Len(varInput & "") > 0 Then intParamsCount = UBound(varReplacements) + 1 If intParamsCount Mod 2 = 0 Then varOutput = varInput For n = 0 To UBound(varReplacements) Step 2 varOutput = Replace(varOutput, varReplacements(n), varReplacements(n + 1)) Next n Else Exit Function End If End If MultiReplacements = varOutput ExitHandler: Exit Function ErrorHandler: Select Case Err.Number Case Is = 94: Resume ExitHandler Case Else MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description Resume ExitHandler End Select End Function Public Function ReplaceResult(ByVal strInput As String) If Nz(strInput, "") = "" Then Exit Function ReplaceResult = MultiReplacements(strInput, ChrW(1577), ChrW(1607), _ ChrW(32), ChrW(32), _ ChrW(1610) & ChrW(32), ChrW(1609) & ChrW(32), _ ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1575) & ChrW(1604), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1575) & ChrW(1604), _ ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(32), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1575) & ChrW(1604) & ChrW(32), _ ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1585) & ChrW(1576) & ChrW(32), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1585) & ChrW(1576) & ChrW(32), _ ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1605) & ChrW(1575) & ChrW(1604) & ChrW(1603), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1575) & ChrW(1604) & ChrW(1603) _ ) End Function ويتم استدعاءه كالتالى ReplaceResult([txt]) واخيرا المرفق الاسماء المركبة.accdb

ابشر بالخير ان شاء الله جارى العمل على اعداد الكود

يا استاذ @رولي اتفضل راجع الموضوع الاتى قمت بالتطوير على الاكواد لاضافاء مرونى فى التعامل مع الاصوات ذوات الامداد MP3 , WAV ودائما احاول قدر المستطاع عند كتابة الأكواد مراعاة التعامل مع كلتا النواتان 32x , 64x

جزاكم الله خيرا

https://www.cdata.com/kb/tech/mysql-odbc-access-linked-tables.rst

نعم

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

ايون لازم ده شرط علشان تشتغل بالعربي

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

مش فاهم على فكرة ممكن توضيح ياريت لو ترفق صورة للمكشلة يكون افضل

تغيير التسمية لازرار صندوق الرسائل و افكار التحكم فى صندوق الرسائل full control arabic Message Box 32x,64x .mdbFull Arabic Message Box V3 32X, 64x.accdb

والله أعلى وأعلم على قدر معلوماتى للاسف PlaySound API الخاصة بتشغيل ملفات صوت ذات الامتداد WAV لا تدعم الإيقاف المؤقت/الاستئناف وننتظر من اساتذتنا أهل الخبرة مراجعتنا فى هذه النقطة إن أمكن وهذا تعديل بسيط علشان خاطر عيونك تدلل PlayAudio V0.2.zip

وهذا مثال اخر باستخدام تغيير لون خط الرسائل ولكن لضيق وقتى لم اتدارك الاخطاء فى استخدام اللغة العربية داخل محرر الأكود هذا المثال فقط لعرض الافكار رابط الموضوع الاصلى Full Arabic Message Box V3 32X, 64x.accdb

تم تعديل المرفق للعمل على كلتا النواتان

الق نظرة على هذه القاعدة رابط الموضوع الصلى full control arabic Message Box 32x,64x .mdb

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

لم اجد تفاعل أو اى رد يدل على نجاح فاعلية التطبيق والتجربة وهذه القواعد للتجربة تم مراعاة عند كتابة الأكواد العمل على كل من النواتان 32x , 64x استاذى الجليل الاستاذ @Moosak اردت فقط الاطمئنان على المكتبة العامرة Moh3sam.zip

شوف الشرح هنا لاستاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @jjafferr