ابو جودي

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

الق نظرة على هذه القاعدة رابط الموضوع الصلى 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() انا شرحت بالتفصيل الممل اياك حد يقول لى عاوز مرفق أو مش عارف يطبق الشرح

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

اساتذتى على رأيان الاول والثانى وهو ما أميل اليه كانت تلك نصائح من استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل مجتمعا ومقرا وموافقا على على كلام استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @jjafferr إقتباس من كلمات وتوجيهات الاستاذ @ابوخليل

طال عمرك .. يا هلا هلا هلا هلا استاذى الجليل ومعلمى القدير والله اشتجنا اعتذر عن غيابى وانقطاعى

هات مرفق

العفو منكم استاذى الجليل فما تصفه بالاطروحات هو فضل الله تعالى أولا ثم من بعده فضل اساتذتى العظماء الذين اتعلم على ايديهم فى هذا الصرح الشامخ اذن طالب يتابع اطروحات طويلب هههههههههه وانا كمان لكن ابشر ان شاء الله ان قدر الله وكان فى العمر بقية فى القريب العاجل افرد لــدوال تحويل البيانات موضوعا مبسطا ------------------- سبحانك لا علم لنا الا ما علمتنا .. هذا فضل الله تعالى لا نافة لى فيه ولا جمل وما فى مجهود ولا شئ هلا والله .... جزاكم الله تعالى اكثر مما تمنيتم ودعوتم لى ان شاء الله انتم وكل اساتذتى واخوانى وكل المسلمين ان شاء الله وأخيرا المرفق ببعض التعديلات الطفيفة جدا جدا جدا على درب استاذى الجليل @دروب مبرمج دون المساس بالتصميم أو تغير شئ اتفضل select top (2).accdb

اعتذر نسيت بالنسبة لسؤال بعد اذن اخى الحبيب ومعلمى القدير الاستاذ @دروب مبرمج شوف يا استاذ @mohamedab557 وركز معايا استاذى الجليل قام بعمل وحدو نمطية لعمل روتين عام اسم هذا الروتين العام هو NewList ولاحظ معى الاتى هناك بين قوسان متغير تم الاعلان هنا باسم SetTop وهو رقم طيب الشكل كاملا لهذا الروتين Function NewList(SetTop As Integer) اذا عند استدعاء الروتين ليقوم بتنفيذ وظيفته لابد ان يكون على النحو الاتى Function NewList( 0 or 1 or 2 or ... or ....) نفهم اذن ان ما بين الاقواس هو متغير رقمى اسند انا اليه القيمة التى اريدها حسب متطلباتى وبما انك تريد ان تكون قيمة ال Top متغيره وتضعها انت من النموذج من واقع مربع النص فيتم استدعاء الوظيقة Function NewList بالشكل التالى NewList(Me.SetNo) وان اعجبت بأفكار استاذى الجليل ومعلمى القدير @دروب مبرمج كما أعجبت أنا بها أكثر من فكرتى انتظر منى تعديلا طفيف جدا جدا جدا بعد إذن استاذى طبعا العفو منكم استاذى الجليل والله اشتجنا

انا لم استطع فهم المطلوب جيدا وهو جسبا فهمت يحمل معنيين الاول ربط الجداول برمجيا وان كان كذلك / اتفضل هاكم طريقتى فى المرفق اتمنى ان تنال رضاكم الثانى العلاقات بين الجداول : وان كنت تقصد ذلك دعنى اقدم اليكم نصيحة لا تقم بعمل الربط بين الجدول الا داخل الاستعلامات وقت الحاجة وحسب المتطلبات اليها Reink Table.zip

اتفضل يا سيدى ولكن وجب التنويه تم تغيير نوع الحقل sales من نصى الى رقمى فى مرفق استاذى الجليل ومعلمى الاستاذ @دروب مبرمج انتبه جيدا لان النتائج سوف تختلف كليا وجزئيا ان نقلت النموذج والموديول من قاعدة استاذى الى قاعدتك الاساسية select ( X ) Top (1).accdb

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

السلام عليكم ومشاركة مع استاذى ومعلمى @دروب مبرمج لانى كنت أفكر فى الحل بأبسط الطرق قمت باستخدام دوال تحويل البيانات لان الحقل المراد التعامل معه حقل نصى ولاننا مستقبلا نريد التعامل مع القيم الرقمية داخل الحقل النصى Sales قمت بعمل استعلام بسيط لتحويل نوع البيانات من نصية الى رقمية من خلال الدالة CLng([sales]) فيكون بناء الاستعلام كالاتى SELECT sales.dname, CLng([sales]) AS FldSales FROM sales; الخطوة الثانية : بعد ذلك الان سوف اتعامل مع هذا الاستعلام وليس الجدول ووضع الكود الاتى على زر الامر على الترتيب الاتى Dim strSQL As String الاعلان عن متغير نصى If IsNull(txtXTop) Or Len(txtXTop) = 0 Then اى ان كان مربع النص txtXTop طول السلسلة النصيه له = 0 اى انه فارغ بدون اى قيم فى هذه الحالة سوف اقوم باسناد جملة الاستعلام البسيط مصدر البيانات الان الى المتغير النصى strSQL strSQL = "SELECT sales.dname, CLng([sales]) AS FldSales FROM sales" اما اذا كان مربع النص txtXTop طول السلسلة النصيه له > 0 اى انه يحتوى على قيم قى هذه الحالة سوف اقوم باسناد جملة الاستعلام الاتية الى المتغير ولكن لان جملة الاستعلام عبارة عن سلسلة نصية سوف اقوم باستخدام دوال تحويل البيانات مرة أخرى ولكن فى هذه المرة اريد تحويل الرقم من مربع النص الى سلسلة نصية لان مربع النص الان هو المتغير الذى يمرر قيمة ال Top لاستكمال صياغة جملة SQL دوى ادنى مشاكل من خلال CStr(txtXTop) قتكون الجملة التى سوق يتم اسنادها بهذا الشكل "SELECT TOP " & CStr(txtXTop) & " * FROM qryData ORDER BY FldSales DESC;" وكانت فكرتى تتمحور حول جعل النموذج يعرض البيانات لذلك سوف اسند الى مصدر بيانات النموذج جملة الاستعلام تبعا للحالة من خلال المتغير Me.RecordSource = strSQL وتم اضافة كود تصيد الاخطاء فى حالة تم استخدام اى شئ يخالف الارقام فى مربع النص على النموذج اعتذر للاطالة واعتذر مسبقا فى جالة وجود اى قصور بسبب محاولتى للابقاء على التصميم دون المساس او التغيير فيه مع محاولة الوصول للنتيجة بأبسط طريق واخيرا المرفق select ( X ) Top.accdb

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

السلام عليكم ورحمة الله تعالى وبركاته من فضل اساتذى الكرام انا فى مشكلة كبيرة جدا فى عملى بسبب هذا الصدد اسأل الله تعالى ان يهديكم ويهدينى تكمن مشكلتى فى جلب البيانات من مربع متعدد القيم المرفق الاتى قى النموذج الموجود اريد ان يعطينى زر الامر النتيجة المرجوة فى رسالة او فى الـ Immediate Windows By Debug.Print يعنى المفروض النتيجة تكون مساوية لقيم مربع السرد Get Value Combo Box Multi Select.accdb

ممكن مع بعض التعديلات

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

طيب وبما انك وصلت للحل لتعم الفائدة Dim db As DAO.Database Dim rst As DAO.Recordset ' Open the database Set db = DBEngine.OpenDatabase(".\officenaDB.mdb") ' Open the Recordset Set rst = db.OpenRecordset ("SELECT * FROM Customers WHERE CustomerId = 'officena'", dbOpenDynaset)

اتفضل استخدم الكود الاتى كروتين عام لعدم كتابة وتكرار الاكواد اكثر من مره حسب عدد الأعمدة Function DoColoer(ByRef Obj As Object) As String Select Case Nz(Obj, "") Case Is = "": DoColoer = vbWhite Case Is = 1: DoColoer = vbBlue Case Is = 2: DoColoer = vbGreen Case Is = 3: DoColoer = vbYellow Case Is = 4: DoColoer = vbRed Case Else End Select End Function ومن مربع السرد لكل عمود استدعى الروتين السابق بهذا السطر ObjectName.BackColor = DoColoer(ComboBoxName) بحيث ObjectName اسم العنصر المراد تغيير لون الخلفية الخاصة به و ComboBoxName اسم مربع التحرير والسرد الخاص بالعمود الذى تريد تغيير لونه واخيرا المرفق بعد التطبيق تحديد اللون بشرط.accdb