ابو جودي

وهذ الكود ان شاء الله يفى بالغرض كما هو المطلوب 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

اتفضل اداة تساعدك مستقبلا من تصميم الاستاذ القدير @Moosak اتفضل شوف الدرس ده ان اردت الشرح والايضاح

ركز معايا وإتفضل نفذ الخطوات الاتية

-تجهيز مجلدات وملف الصوت الخطوة الاولى قم بانشاء مجلد جديد فى مسار قاعدة البيانات الحالى باسم ( Resurce ) الخطوة الثانية قم بفتح المجلد السابق وقم بانشاء مجلد جديد بداخله باسم ( Audio Files ) الخطوة الثالثة قم بنسخ ملف صوت الى المجلد ( Audio Files ) اما بامتداد wav , .mp3. --------------------- -تجهيز قاعدة البيانات الخطوة الاولى قم بانشاء وحدة نمطية باسم ( modPlayAudio ) وقم بلصق الاكواد الاتية فى هذه الوحدة النمطية Option Compare Database Option Explicit #If VBA7 And Win64 Then Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long Private Declare PtrSafe Function playSound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long #Else Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long Private Declare Function playSound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long #End If Const SND_ALIAS_SYSTEMASTERISK As String = "SystemAsterisk" Const SND_ALIAS_SYSTEMDEFAULT As String = "SystemDefault" Const SND_ALIAS_SYSTEMEXCLAMATION As String = "SystemExclamation" Const SND_ALIAS_SYSTEMEXIT As String = "SystemExit" Const SND_ALIAS_SYSTEMHAND As String = "SystemHand" Const SND_ALIAS_SYSTEMQUESTION As String = "SystemQuestion" Const SND_ALIAS_SYSTEMSTART As String = "SystemStart" Const SND_ALIAS_SYSTEMWELCOME As String = "SystemWelcome" Const SND_ALIAS_YouGotMail As String = "MailBeep" ' playsound Params Const SND_LOOP = &H8 Const SND_ALIAS = &H10000 Const SND_NODEFAULT = &H2 ' silence if no sound associated with event Const SND_ASYNC = &H1 ' play async (don't freeze program while sound is playing) Private sMusicFile As String Public soundOn As Boolean Dim mp3Path As String Dim wavPath As String Dim Play As Variant Public Sub Sound_MP3(ByVal File$) sMusicFile = GetShortPath(File) Play = mciSendString("play " & sMusicFile, 0&, 0, 0) If Play <> 0 Then End If End Sub Public Sub Stop_MP3(Optional ByVal FullFile$) Play = mciSendString("close " & sMusicFile, 0&, 0, 0) End Sub Public Function GetShortPath(ByVal strFileName As String) As String Dim lngRes As Long, strPath As String strPath = String$(165, 0) lngRes = GetShortPathName(strFileName, strPath, 164) GetShortPath = Left$(strPath, lngRes) End Function Function IsFile(ByVal fName As String) As Boolean On Error Resume Next IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory) End Function Public Function AudioFilePath() As String AudioFilePath = CurrentProject.Path & "\Resurce\Audio Files\" End Function Public Function PlayFile(ByVal FileName_ As String) Dim Msg As String Msg = ChrW(1578) & ChrW(1571) & ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & ChrW(1608) & ChrW(1580) & _ ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1587) & ChrW(1575) & ChrW(1585) & ChrW(32) & ChrW(40) & ChrW(32) & _ ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(32) & ChrW(47) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & _ ChrW(1578) & ChrW(41) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(46) & _ ChrW(13) & ChrW(10) & ChrW(1578) & ChrW(1571) & ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & _ ChrW(1608) & ChrW(1580) & ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(40) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & _ ChrW(32) & ChrW(47) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & ChrW(1578) & ChrW(41) & ChrW(32) & _ ChrW(1575) & ChrW(1604) & ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(1601) & ChrW(1609) & ChrW(32) & ChrW(1575) & _ ChrW(1604) & ChrW(1605) & ChrW(1587) & ChrW(1575) & ChrW(1585) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1605) & _ ChrW(1581) & ChrW(1583) & ChrW(1583) & ChrW(32) & ChrW(46) & ChrW(13) & ChrW(10) & ChrW(1578) & ChrW(1571) & _ ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & ChrW(1575) & ChrW(1587) & ChrW(1605) & _ ChrW(32) & ChrW(32) & ChrW(40) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(32) & ChrW(47) & ChrW(32) & _ ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & ChrW(1578) & ChrW(41) & ChrW(32) & ChrW(1575) & ChrW(1604) & _ ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(46) mp3Path = AudioFilePath & FileName_ & ".mp3" wavPath = AudioFilePath & FileName_ & ".wav" StopFile If IsFile(mp3Path) Then Sound_MP3 (mp3Path): Exit Function If IsFile(wavPath) Then playSound (wavPath), vbNull, SND_ALIAS Or SND_NODEFAULT Or SND_ASYNC: Exit Function If IsFile(mp3Path) = IsFile(wavPath) Then MsgBox (Msg), vbOKOnly + vbMsgBoxRtlReading + vbMsgBoxRight: Exit Function End Function Public Function StopFile() playSound vbNullString, ByVal 0&, SND_NODEFAULT Stop_MP3 (mp3Path) End Function الخطوة الثانية قم بانشاء نموذج باسم ( frmPlayAudio ) الخطوة الثالثة قم بانشاء مربع نص فى النموذج السابق باسم ( txtAudioFileName ) الخطوة الرابعة قم بانشاء زر أمر فى النموذج السابق باسم ( cmdPlay ) وفى حدث عند النقر ضع الكود الاتى soundOn = True: PlayFile (Me.txtAudioFileName) الخطوة الخامسة قم بانشاء زر أمر فى النموذج السابق باسم ( cmdStop ) وفى حدث عند النقر ضع الكود الاتى StopFile الخطوة السادسة فى حدث عند إغلاق النموذج ضع الكود الاتى StopFile الخطوة السابعة بعد حفظ ما سبق افتح النموذج وادخل فى مربع النص ( txtAudioFileName ) اسم ملف الصوت الموجود فى المسار المحدد بدون الامتداد مثلا لو ملف الصوت باسم : MyAudio.mp3 Or MyAudio.wav اسم ملف الصوت فى مربع النص ( txtAudioFileName ) يكون فى الشكل الاتى فقط : MyAudio والان جرب الضغط على زر الامر الخاص بالتشغيل تارة وزر الامر الخاص بالايقاف تارة أخرى طيب ملاحظة مهمه : الطريقة ودوال API هنا تقوم بتشغيل ملفات صوت من النوعين MP3 . WAV <<---< والله دلع شغل فاخر من الأخر تم صياغة الكود بمرونه مطلقة للتعامل مع الملف بغض النظر عن امتداد الملف اه والله زيمبئولك كده مش مصدق ليه مش بئولك شغل فاخر اللى مش عاجبه المسار لملفات الصوت او عاوز يغير مكانها او اسمها طبعا فى الموديول يغير فى الروتين ده على مزاجه AudioFilePath() انا شرحت بالتفصيل الممل اياك حد يقول لى عاوز مرفق أو مش عارف يطبق الشرح