هل يمكن تشغيل ملف صوتي من جوار فولدرات الاكسل

[الراعدي]

السلام عليكم

كيف يمكن تشغيل ملف صوتيmp3 بصورة تلقائية   من جوار الفولدرات  عند فتح ملف الاكسل

[lionheart]

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWNORMAL As Long = 1

Sub PlayMusic(strFile As String)
    If ShellExecute(0&, "Play", strFile, 0&, 0&, SW_SHOWNORMAL) < 33 Then
        MsgBox "Something Went Wrong", vbInformation
    End If
End Sub

Sub Test_PlayMusic()
    Call PlayMusic(ThisWorkbook.Path & "\YOURFILE.mp3")
End Sub

 

[الراعدي]

تم اضافة الكود في محرر الاكواد لكن الصوت لم يشتغل من جوار الفولدرات.

 

ممكن تفعيل تشغيل الملف الصوتي عند فتح ملف الاكسل

الملف الصوتي.rar

[الراعدي]

صوت من داخل جوار الفولدرات.xlsb

[lionheart]

In standard module put the code

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 Play, sMusicFile As String

Sub Play_MP3_File()
    PlaySound ThisWorkbook.Path & "\YOURFILE.mp3"
End Sub

Public Sub PlaySound(ByVal File$)
    Dim sPath As String, sFileName As String
    sMusicFile = File
    Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
    If Play <> 0 Then
        sPath = CurDir
        If InStr(sMusicFile, ":") > 0 Then ChDrive (Left(sMusicFile, 1))
        If InStr(sMusicFile, "\") > 0 Then
            ChDir (Left(sMusicFile, InStrRev(sMusicFile, "\") - 1))
            sFileName = Mid(sMusicFile, InStrRev(sMusicFile, "\") + 1)
            If InStr(sFileName, " ") > 0 Then
                FileCopy sFileName, Replace(sFileName, " ", "")
                sMusicFile = Left(sMusicFile, InStrRev(sMusicFile, "\")) & Replace(sFileName, " ", "")
                Play = mciSendString("play " & Replace(sFileName, " ", ""), 0&, 0, 0)
            Else
                Play = mciSendString("play " & sFileName, 0&, 0, 0)
            End If
        Else
            sFileName = Replace(sMusicFile, " ", "")
            If sMusicFile <> sFileName Then FileCopy sMusicFile, sFileName: sMusicFile = sFileName
            Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
        End If
        ChDrive (Left(sPath, 1))
        ChDir (Left(sPath, InStrRev(sPath, "\") - 1))
    End If
End Sub

Public Sub StopSound(Optional ByVal FullFile$)
    Play = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub

 

Then in ThisWorkbook module put the code

Private Sub Workbook_Open()
    Call Play_MP3_File
End Sub

 

[الراعدي]

انا جربت اضافت الكود لكن لم يعمل الكود والصوت mp3  .

 

 

لو سمحت ضيف الكود في ملف الاكسل مع الملف الصوتي

انا ضفت الكود والملف الصوتي ظهرت لي مشكلة

كيف يمكن حل هذه المشكلة

[lionheart]

It seems you are using Windows 32Bit so remove the word PtrSafe from the first line that appears in red color