Inserimento file musicale al raggiungimento di un obiettivo.

Anonimo
2020-05-04T23:44:14+00:00

Ciao,

in Access, per ascoltare un suono musicale proveniente da un file esterno, mi servo del seguente codice:

Option Compare Database

Option Explicit

#If 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

#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

#End If

Private sMusicFile As String

Private Play

Public Sub PlaySound()

sMusicFile = Application.CurrentProject.Path & "\R.Mp3"

Play = mciSendString("play " & sMusicFile, 0&, 0, 0)

If Play <> 0 Then

End If

End Sub

Public Sub StopSound()

    sMusicFile = "R.mp3"

    Play = mciSendString("close " & sMusicFile, 0&, 0, 0)

End Sub

Purtroppo in Excel mi dà errore.

Vladimiro

Microsoft 365 e Office | Excel | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo
2020-05-05T02:01:23+00:00

Ciao Vladimiro,

Ciao,

in Access, per ascoltare un suono musicale proveniente da un file esterno, mi servo del seguente codice:

Option Compare Database

Option Explicit

#If 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

#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

#End If

Private sMusicFile As String

Private Play

Public Sub PlaySound()

sMusicFile = Application.CurrentProject.Path & "\R.Mp3"

Play = mciSendString("play " & sMusicFile, 0&, 0, 0)

If Play <> 0 Then

End If

End Sub

Public Sub StopSound()

    sMusicFile = "R.mp3"

    Play = mciSendString("close " & sMusicFile, 0&, 0, 0)

End Sub

Purtroppo in Excel mi dà errore.

Vladimiro

Prova qualcosa del genere:

'=========>>

Option Explicit

#If 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

#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

#End If

Private Declare Function GetShortPathName _

                          Lib "kernel32" _

                              Alias "GetShortPathNameA" _

                              (ByVal lpszLongPath As String, _

                               ByVal lpszShortPath As String, _

                               ByVal lBuffer As Long) As Long

Private Current As String

Private Const sFilename As String = "R.mp3"                '<<=== Modifica

'--------->>

Private Sub PlayTune(Play As Boolean, FullPathTune$, Optional Reprise& = 0)

    Dim Tune As String

    On Error Resume Next

    Call mciSendString("Stop MPFE", 0&, 0, 0)

    Call mciSendString("Close MPFE", 0&, 0, 0)

    If Not Play Then Exit Sub

    Tune = FullPathTune

    If Dir(Tune) = "" Then Exit Sub

    Tune = GetShortPath(Tune)

    Call mciSendString("Open " & Tune & " Alias MPFE", 0&, 0, 0)

    Call mciSendString("play MPFE from " & Reprise, 0&, 0, 0)

End Sub

'--------->>

Private Function GetShortPath(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

'--------->>

Public Sub PlaySound()

    Call PlayTune(True, ThisWorkbook.Path & "" & sFilename)

End Sub

'--------->>

Public Sub stopSound()

    Call PlayTune(False, ThisWorkbook.Path & "" & sFilename)

End Sub

'<<=========

===

Regards,

Norman

La risposta è stata utile?

1 persona ha trovato utile questa risposta.
0 commenti

2 risposte aggiuntive

Ordina per: Più utili
Più utili Più recente Meno recente
  1. Anonimo
    2020-05-05T09:21:20+00:00

    Ciao Vladimiro,

    funziona perfettamente.

    Grazie mille,

    Ti ringrazio per il cortese riscontro.

    Alla prossima.

    ===

    Regards,

    Norman

    La risposta è stata utile?

    0 commenti
  2. Anonimo
    2020-05-05T06:35:50+00:00

    Ciao Vladimiro,

    Ciao,

    in Access, per ascoltare un suono musicale proveniente da un file esterno, mi servo del seguente codice:

    Option Compare Database

    Option Explicit

    #If 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

    #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

    #End If

    Private sMusicFile As String

    Private Play

    Public Sub PlaySound()

    sMusicFile = Application.CurrentProject.Path & "\R.Mp3"

    Play = mciSendString("play " & sMusicFile, 0&, 0, 0)

    If Play <> 0 Then

    End If

    End Sub

    Public Sub StopSound()

        sMusicFile = "R.mp3"

        Play = mciSendString("close " & sMusicFile, 0&, 0, 0)

    End Sub

    Purtroppo in Excel mi dà errore.

    Vladimiro

    Prova qualcosa del genere:

    '=========>>

    Option Explicit

    #If 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

    #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

    #End If

    Private Declare Function GetShortPathName _

                              Lib "kernel32" _

                                  Alias "GetShortPathNameA" _

                                  (ByVal lpszLongPath As String, _

                                   ByVal lpszShortPath As String, _

                                   ByVal lBuffer As Long) As Long

    Private Current As String

    Private Const sFilename As String = "R.mp3"                '<<=== Modifica

    '--------->>

    Private Sub PlayTune(Play As Boolean, FullPathTune$, Optional Reprise& = 0)

        Dim Tune As String

        On Error Resume Next

        Call mciSendString("Stop MPFE", 0&, 0, 0)

        Call mciSendString("Close MPFE", 0&, 0, 0)

        If Not Play Then Exit Sub

        Tune = FullPathTune

        If Dir(Tune) = "" Then Exit Sub

        Tune = GetShortPath(Tune)

        Call mciSendString("Open " & Tune & " Alias MPFE", 0&, 0, 0)

        Call mciSendString("play MPFE from " & Reprise, 0&, 0, 0)

    End Sub

    '--------->>

    Private Function GetShortPath(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

    '--------->>

    Public Sub PlaySound()

        Call PlayTune(True, ThisWorkbook.Path & "" & sFilename)

    End Sub

    '--------->>

    Public Sub stopSound()

        Call PlayTune(False, ThisWorkbook.Path & "" & sFilename)

    End Sub

    '<<=========

    ===

    Regards,

    Norman

    Ciao Norman,

    funziona perfettamente.

    Grazie mille,

    Vladimiro

    La risposta è stata utile?

    0 commenti