تشغيل ملف صوتي بامتداد WAV عند تحديد خلية معينة

[ياسر خليل أبو البراء]

السلام عليكم ورحمة الله وبركاته

إخواني وأحبابي في الله

بدايةً من هذا الموضوع لن أقوم بإرفاق ملفات في الموضوع وسأترك لكم التطبيق العملي بأنفسكم (حتى نتطور) ... كفانا ملفات مرفقة جاهزة

فرأيي أن الملفات المرفقة الجاهزة تبعث على الكسل بشكل كبير .. كل ما يقوم به العضو هو تحميل الملف المرفق ثم تجربته ولو تيسر له الأمر قليلاً لألقى نظرة على العمل وعلى الأكواد الموجودة ..وقلما تجد من يدرس الملف المرفق بهدف التعلم

من ثم .. فهذا الموضوع موجه لمن يريد ويرغب بالتعلم وليس لمن يريد الملفات الجاهزة ..

سأقوم إن شاء ربي بسرد الخطوات ببساطة شديدة يفهمها الجميع (المبتديء قبل المحترف)

نبدأ على بركة الله

افتح ملف إكسيل جديد (خطوة صعبة بس أنا عارف إن 90% هيقدر على الخطوة دي )

احفظ الملف الجديد بامتداد xlsm أو Excel Macro-Enabled .. لمعرفة المزيد يمكنك الإطلاع على موضوع (بداية الطريق لإنقاذ الغريق)

روح لمحرر الاكواد عن طريق Alt + F11 وأدرج موديول جديد من خلال القائمة Insert ثم الأمر Module

الصق الكود التالي في الموديول

#If VBA7 Then
    Public Declare PtrSafe Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
#Else
    Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
#End If

Sub PlayWavFile(WavFileName As String, Wait As Boolean)
    If Dir(WavFileName) = "" Then Exit Sub
    If Wait Then
        sndPlaySound WavFileName, 0
    Else
        sndPlaySound WavFileName, 1
    End If
End Sub

Sub PlaySoundNotesInExcel(CellAddress As String)
    Dim SoundFileName As String
    SoundFileName = ""
    On Error Resume Next
    SoundFileName = Range(CellAddress).Comment.Text
    On Error GoTo 
    
    If SoundFileName = "" Then Exit Sub
    If InStr(1, SoundFileName, Chr(10)) > 0  Then
        SoundFileName = Left(SoundFileName, InStr(1, SoundFileName, Chr(10)) - 1)
    End If
    PlayWavFile SoundFileName, False
End Sub

هرفق ملف صوتي بامتداد WAV للتطبيق عليه .. الملف باسم TestWAV

فك الضغط عن الملف المضغوط هتلافي اسم الملف TestWAV اعمل عليه كليك يمين ثم الأمر Properties أي خصائص

روح للتبويب Security (بس اوعى بتوع الأمن يقفشوك) ..المهم هتلاقي سطر بهذا الشكل (مسار الملف الصوتي)

C:\Users\Future\Desktop\TestWAV.wav

دا هيكون شكل المسار للملف ..طبعاً هيختلف من جهاز لجهاز آخر .. المهم انسخ سطر المسار ده

 

الخطوة التالية ..شوف أي خلية تريد أن يعمل الصوت عند تحديدها ليكن الخلية G7 (أصلي بحب رقم 7 والعمود G هو العمود السابع وفي نفس الوقت الصف السابع .. متدقش على كلامي)

كليك يمين على الخلية (بزر الماوس الأيمن يا حاج أيمن .. شايف واحد بيبص على الماوس مفيش مشكلة المهم يعرف يطبق)

اختر الأمر Insert Comment أي إدراج تعليق ، ممكن تلاقي كلام امسحه وخلي التعليق فاضي ، وأخيراً ضع المسار اللي نسخته من شوية عن طريق Ctrl + V أي لصق المنسوخ .. لحد هنا بس خلاص

 

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

كليك يمين على اسم ورقة العمل ثم اختر الأمر View Code والصق الكود التالي في حدث ورقة العمل

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    PlaySoundNotesInExcel (Target.Address)
End Sub

سؤال أخير . هل العمل سيكون على خلية واحدة فقط ؟؟

الإجابة : لا ..براحتك ...كل ما عليك بعد كدا لو عايز تشغل الملف الصوتي أو أي ملف صوتي آخر ..إنك تاخد المسار وتروح للخلية وتدرج تعليق وفي التعليق تضع مسار الملف الصوتي المراد تشغيله وبس خلاص

أرجو أن يكون الشرح سهل وبسيط وسلس ... ويكون التطبيق فيه مشاكل (أيوا فيه مشاكل عشان يكون فيه استفسارات ونتعلم)

دمتم على طاعة الله

كان معكم أخوكم أبو البراء من منتدى أوفيسنا

 

حمل الملف من هنا

[Yasser Fathi Albanna]

انا خلصت الواجب أرفق الملف

[ياسر خليل أبو البراء]

أخي الحبيب ياسر فتحي

بارك الله فيك وجزيت خيراً على اهتمامك

لا ترفق الملف ..ارفع الملف على رابط خارجي وابعته في رسالة خاصة ..

ولو فيه أي نقطة غير واضحة يا ريت تستفسر عنها عشان يكون الموضوع شامل

تقبل تحياتي

[Yasser Fathi Albanna]

حاضر

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

[عبد العزيز البسكري]

السّلام عليكم و رحمة الله و بركاته

بارك الله فيك  و جزاك الله خيرًا ..أستاذنا القدير "ياسر خليل" على هذا الامتحان المهني

خلّصت الواجب ..و سأبعثه .. لا تخفْ ..  لأنّه طلع 0 على عشرة .. اللّمسة الأخيرة تنقصني

فائق إحتراماتي

 

 

 

yasser.rar

[Yasser Fathi Albanna]

تم الإرسال فى رسالة خاصة

تم تعديل نوفمبر 3, 2015 بواسطه م / ياسر فتحى البنا

[ياسر العربى]

قال معايا الحمد لله رب العالمين ابعته ولا بلاش

وخصوصا في الصف سبعه عمود سبعه

معلش انا تلميذ رخم بقي

وعجبني الكود كدا

تم تعديل نوفمبر 3, 2015 بواسطه ياسر العربى

[ياسر العربى]

السّلام عليكم و رحمة الله و بركاته

بارك الله فيك  و جزاك الله خيرًا ..أستاذنا القدير "ياسر خليل" على هذا الامتحان المهني

خلّصت الواجب ..و سأبعثه .. لا تخفْ ..  لأنّه طلع 0 على عشرة .. اللّمسة الأخيرة تنقصني

فائق إحتراماتي

 

 

 

yasser.rar

اخي عبد العزيز انت اخويا ولازم اساعدك

اتفضل التوضيح هنا

بعد اذن الغالي

انا سايب الكومنت فاضي عشان تطبق بردو

 

TestWAV.rar

تم تعديل نوفمبر 3, 2015 بواسطه ياسر العربى

[ياسر خليل أبو البراء]

أخي الحبيب عبد العزيز

في انتظار التطبيق .. ويا ريت تطبق ع الجديد .. اللي هو عمله أخونا ياسر العربي

أخي الحبيب الغالي ياسر العربي

إضافة في قمة الروعة بالتأكيد .. كونك تجعل مسار الملف الصوتي في نفس مسار المصنف (ودا أمر مستحب بالنسبة لي) بس ممكن ييجي واحد رخم زي حالاتي بردو ويقولك لا أنا مش عايز الملف الصوتي في نفس مسار المصنف (رخامة بقا)

عموماً إضافة جميلة وأنا أحبذها وأررجحها ودا التعديل الجديد للأخ ياسر العربي

الكود بالكامل في الموديول

#If VBA7 Then
    Public Declare PtrSafe Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
#Else
    Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
#End If

Sub PlayWavFile(WavFileName As String, Wait As Boolean)
    If Dir(WavFileName) = "" Then Exit Sub
    If Wait Then
        sndPlaySound WavFileName, 0
    Else
        sndPlaySound WavFileName, 1
    End If
End Sub

Sub PlaySoundNotesInExcel(CellAddress As String)
    Dim SoundFileName As String, MyPath As String
    SoundFileName = ""
    On Error Resume Next
    MyPath = ThisWorkbook.Path & "\"
    SoundFileName = MyPath + Range(CellAddress).Comment.Text
    On Error GoTo 0
    
    If SoundFileName = "" Then Exit Sub
    If InStr(1, SoundFileName, Chr(10)) > 0 Then
        SoundFileName = Left(SoundFileName, InStr(1, SoundFileName, Chr(10)) - 1)
    End If
    PlayWavFile SoundFileName, False
End Sub

تم إضافة سطر وتعديل سطر

MyPath = ThisWorkbook.Path & "\"
    SoundFileName = MyPath + Range(CellAddress).Comment.Text

بارك الله فيك أخي الغالي ياسر وفي انتظار المزيد من الرخامات المستحبة لي

[مختار البركاني]

شكرا اخي الاستاذ

ياسر خليل أبو البراء

تم التنفيذ بنجاح

[ياسر خليل أبو البراء]

أخي الكريم مختار

الحمد لله أن تم التنفيذ بنجاح ومشكور على متابعتك واهتمامك بالتعلم

[صلاح الصغير]

ا / ياسر 

اعتقد و الله اعلم فى مشكلة فى ظهور رقم صفر فى الكود فى سطرين فى المشاركة الاولى

sndPlaySound WavFileName, 

If InStr(1, SoundFileName, Chr(10)) >  Then

انا عملت كل الخطوات و لم ينفذ الكود

ما عرفتش المشكلة الا من مرفق الاستاذ عبد العزيز

المرفقات مهمة بردو يا استاذ ياسر

[ياسر خليل أبو البراء]

أخي الكريم صلاح الصغير

معك حق المرفقات مهمة للغاية ، ولكن يجب ألا تعتمد عليها بشكل أساسي لابد أن تتعلم أن تطبق الكود بنفسك ، وصدقني لن تتعلم إلا إذا صادفتك مشكلات ، فالبرمجة الأصل فيها حل المشكلات

تقبل تحياتي

[صلاح الصغير]

في ٣٠‏/٦‏/٢٠١٦ at 10:48, ياسر خليل أبو البراء said:

أخي الكريم صلاح الصغير

معك حق المرفقات مهمة للغاية ، ولكن يجب ألا تعتمد عليها بشكل أساسي لابد أن تتعلم أن تطبق الكود بنفسك ، وصدقني لن تتعلم إلا إذا صادفتك مشكلات ، فالبرمجة الأصل فيها حل المشكلات

تقبل تحياتي

اخى الكريم / ياسر

و الله جربته خطوة خطوة زى ما قلتلك فى المشاركة السابقة

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

 

[ياسر خليل أبو البراء]

ما هو الجزء الناقص لتصحيح الموضوع أخي الكريم صلاح؟

يرجى الإفادة حتى لا يقع غيرك من إخوانك في مثل ما وقعت فيه

[صلاح الصغير]

ا / ياسر

رقم 0 فى اخر السطر غير مكتوب بالنسبة للسطر الاول

و ايضا رقم 0 غير مكتوب بعد علامة < بالنسبة للسطر التانى

 

sndPlaySound WavFileName, 

If InStr(1, SoundFileName, Chr(10)) >  Then

 

[ياسر خليل أبو البراء]

كلامك صحيح يبدو أن الخطأ في المشاركة الأولى ، وقد تم تصحيحها الآن

ولكن في مشاركة أخرى تم التصحيح والإضافة ..

الأفضل لتطبيق أي موضوع متابعة الردود لكي تستطيع التطبيق بشكل صحيح ..

وسأترك لك أن تقوم بإرفاق ملف بعد التطبيق ليستفيد الأعضاء الجدد من الموضوع بشكل تطبيقي

تقبل تحياتي وكل عام وأنت بخير

 

[صلاح الصغير]

ا / ياسر

تم تنفيذ المطلوب

اصوات.rar

[ياسر خليل أبو البراء]

أخي العزيز صلاح

الله ينور عليك ..تمام التمام

وكدا يكون فيه ملف تطبيقي في الموضوع عشان محدش يتعثر مرة تانية

بارك الله فيك وزادك علماً وحلماً

تقبل تحياتي وكل عام وأنت بخير

 

[صلاح الصغير]

ا / ياسر

الشكر و الفضل بعد ربنا لحضرتك و الاساتذة الكرام

و كل عام و كل اعضاء المنتدى بخير