Autres [RÉSOLU] Jouer un son .Wav

un internaute

XLDnaute Occasionnel
Bonsoir le forum
Je voudrais pouvoir émettre un son en plus du message.
Les 2 cellules E3 et E8 sont vides.
Lorsque je remplis la cellule E3 il est impossible de remplir cellule E8. Ça le fait bien mais en plus du message je voudrais faire émettre un son court et non pas Logoff.wav qui est fort et long
Et inversement E8 occupée impossible de remplir cellule E3 tout ça fonctionne très bien.
Manque un son court.
Merci pour vos éventuels retours
Cordialement

PS: Je suis sous Excel 2003 et j'ai aussi posté sur un autre forum. J'ai eu des réponses (une en particulier chez qui ça fonctionne mais pas chez moi).


Macro -ci-dessous dans ThisWorkbook


VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim Ladate As Date

  Application.ScreenUpdating = False
  If Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  ' On recherche si la page est surveillée
  If Left(Sh.Name, 7) = "Charges" Then  'Le chiffre 7 = Nombre de lettres du mot "Charges".On peut mettre 8 avec un espace après "Charges " pour une sécurité.
    If Not Intersect(Range("B12:B112,E12:E112"), Target) Is Nothing Then

      If Target.Interior.ColorIndex = 2 Then
        ' Si la colonne B et la colonne E est vide on efface la date
        Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("E" & Target.Row) = "", "", Application.Proper(Format(Date, "dddd dd mmmm yyyy")))

        ' ********* Début Modifs. Tapez le Montant (colonnes E ou B) et éventuellement Modifier les Dates (Colonne A) sous le format suivant => 07/02/20 (Exemple)
      End If
      '
      ' Début modification du 05/08/2020 : Inscription automatique date en cellule A17
    ElseIf Not Intersect(Range("E7,J2"), Target) Is Nothing Then
      If Target = "" Then
        Range("A18").ClearContents           ' Suppression date si SUPPR cellule E6
      Else
        If Range("E18") = Range("E7") Then
          Range("A18") = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))        ' Sinon on inscrit la date
        End If
      End If
      ' Fin modification du 05/08/2020 : Inscription automatique date en cellule A17
      '
    ElseIf Target.Column = 1 And Target.Row > 12 And Target.Interior.ColorIndex = 2 Then   'Ajout de And Target.Interior.ColorIndex = 2 pour pouvoir recopier texte ligne
      If IsDate(Target) Then
        Target = Application.Proper(Format(Target, "dddd dd mmmm yyyy"))        ' Sinon on inscrit la date
      Else
        Target = ""
        ' ***************** Fin modifs

      End If
    
    'Début modifs le 14/02/2021
    ElseIf Not Intersect(Target, Union(Range("E3"), Range("E8"))) Is Nothing Then
      x = Range("E3").Value
      y = Range("E8").Value
      If (x <> "") And (y <> "") Then
        JouerSon
        Target.ClearContents
        MsgBox "Impossible de saisir une valeur dans cellule " & Target.Address(rowabsolute:=False, columnabsolute:=False) & " car cellule " & IIf(Target.Address = "$E$8", "E3", "E8") & " renseigné"
      End If
    'Fin modifs le 14/02/2021
    
    End If
  End If
  Application.EnableEvents = True
End Sub
Code:

Dans module


Code:
Option Explicit

Private Declare Function PlaySound& Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName$, _
        ByVal hModule&, ByVal dwFlags&)

Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000

Sub JouerSon()
Dim MonWav As String
    MonWav = "C:\Users\toto\Desktop\Logoff.wav"     '... chemin et nom à adapter
    Call PlaySound(MonWav, 0&, SND_ASYNC Or SND_FILENAME)
End Sub
 

un internaute

XLDnaute Occasionnel
Oui mais on tourne en rond alors j'ai tenté sur un autre forum.
J'ai fait tester aussi par un ancien du forum Excel pratique qui était aussi au top en son temps et c'est lui qui m'a dit essaye sur le forum car lui ne voit pas non plus et chez lui Excel 2010 fonctionne pas non plus et il a le fichier.
En tout cas merci à toi patricktoulon (l'ancien te connait) et tous les autres des deux forums
Il n'y a pas mort d'homme.
Je vais mettre Résolu ça évitera aux autres de chercher pour rien.
Le message suffira.
ENCORE UN GRAND MERCI A TOUS DES DEUX FORUMS
Bonne fin de soirée.
Très cordialement
 

un internaute

XLDnaute Occasionnel
Oui mais on tourne en rond alors j'ai tenté sur un autre forum.
J'ai fait tester aussi par un ancien du forum Excel pratique qui était aussi au top en son temps et c'est lui qui m'a dit essaye sur le forum car lui ne voit pas non plus et chez lui Excel 2010 fonctionne pas non plus et il a le fichier.
En tout cas merci à toi patricktoulon (l'ancien te connait) et tous les autres des deux forums
Il n'y a pas mort d'homme.
Je vais mettre Résolu ça évitera aux autres de chercher pour rien.
Le message suffira.
ENCORE UN GRAND MERCI A TOUS DES DEUX FORUMS
Bonne fin de soirée.
Très cordialement

Bonjour le forum
Trouvé en 5 minutes après y avoir passé des heures.
Dans un module
Sub JouerSon()

' Joue le son du fichier C:\Windows\Media\Windows Exclamation.wav.wav

Application.ExecuteExcel4Macro "SOUND.PLAY(,""C:\Windows\Media\Windows Exclamation.wav"")"

End Sub

Puis dans ThisWorkbook

JouerSon

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim Ladate As Date

Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
' On recherche si la page est surveillée
If Left(Sh.Name, 7) = "Charges" Then 'Le chiffre 7 = Nombre de lettres du mot "Charges".On peut mettre 8 avec un espace après "Charges " pour une sécurité.
If Not Intersect(Range("B12:B112,E12:E112"), Target) Is Nothing Then

If Target.Interior.ColorIndex = 2 Then
' Si la colonne B et la colonne E est vide on efface la date
Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("E" & Target.Row) = "", "", Application.Proper(Format(Date, "dddd dd mmmm yyyy")))

' ********* Début Modifs. Tapez le Montant (colonnes E ou B) et éventuellement Modifier les Dates (Colonne A) sous le format suivant => 07/02/20 (Exemple)
End If
'
' Début modification du 05/08/2020 : Inscription automatique date en cellule A17
ElseIf Not Intersect(Range("E7,J2"), Target) Is Nothing Then
If Target = "" Then
Range("A18").ClearContents ' Suppression date si SUPPR cellule E6
Else
If Range("E18") = Range("E7") Then
Range("A18") = Application.Proper(Format(Date, "dddd dd mmmm yyyy")) ' Sinon on inscrit la date
End If
End If
' Fin modification du 05/08/2020 : Inscription automatique date en cellule A17
'
ElseIf Target.Column = 1 And Target.Row > 12 And Target.Interior.ColorIndex = 2 Then 'Ajout de And Target.Interior.ColorIndex = 2 pour pouvoir recopier texte ligne
If IsDate(Target) Then
Target = Application.Proper(Format(Target, "dddd dd mmmm yyyy")) ' Sinon on inscrit la date
Else
Target = ""
' ***************** Fin modifs

End If

'Début modifs le 14/02/2021
ElseIf Not Intersect(Target, Union(Range("E3"), Range("E8"))) Is Nothing Then
x = Range("E3").Value
y = Range("E8").Value
If (x <> "") And (y <> "") Then
JouerSon
Target.ClearContents
MsgBox "Impossible de saisir une valeur dans cellule " & Target.Address(rowabsolute:=False, columnabsolute:=False) & " car cellule " & IIf(Target.Address = "$E$8", "E3", "E8") & " renseigné"
End If
'Fin modifs le 14/02/2021

End If
End If
Application.EnableEvents = True
End Sub
Grâce au lien ci-dessous qui date de juillet 2013 je crois
Merci à tous
Bonne fin de journée à tous
Cordialement
 

patricktoulon

XLDnaute Barbatruc
re
BONJOUR

je vais quand même attirer ton attention sur un petit détail qui a son importance

teste ses deux petites choses comme ça dans un fichier vierge et regarde le curseur de ta souris (celui de l'attente sablier ou cercle )

VB:
Sub joueBeepWindows2ApiBlack()
Dim MonWav As String
    MonWav = "C:\Windows\Media\Windows Exclamation.wav"     '... chemin et nom à adapter
  ExecuteExcel4Macro ("CALL(""winmm"",""PlaySoundA"",""JCJJ"",""" & MonWav & """, " & 0 & "," & &H1 & ")")
End Sub


Sub joueBeepWindows3()
Application.ExecuteExcel4Macro "SOUND.PLAY(,""C:\Windows\Media\Windows Exclamation.wav"")"
End Sub

dans le lien que tu donne dans l'autre forum on parle de synchronisation avec un msgbox ben on est en plein dedans ;)

avec la tienne le message se déclencherait après la FIN !!! du beep et la fermeture de l'object playsound
 

patricktoulon

XLDnaute Barbatruc
re
c'est parce que sound.play fait appel à l'ancienne api similaire sndsoundplay de la même DLL
sauf que sndsoundplay par rapport à soundplayA n'a pas d'argument pour désynchroniser de l’exécuteur en l’occurrence l'app excel par la macro4 donc vba est bloqué tant que le son n'est pas fini de jouer

soundplayA avec l'argument libère le process appelant

tiens comme ca tu pourra pas dir que tu sais pas
VB:
Public Declare Function sndPlaySoundA Lib "winmm.dll" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
'original avec api déclaré!!!!(voir ci dessus
Sub jouerson1() 's'execute uniquement syncro (lache vba quand le son est fini)
    Dim MonWav As String
    MonWav = "C:\Windows\Media\Windows Exclamation.wav"     '... chemin et nom à adapter
    sndPlaySoundA MonWav, 0
End Sub

'celle ci c'est la meme sauf que l'on a pas à déclarer l'api en haut de module
Sub joueBeepWindows1()
Dim MonWav As String
    MonWav = "C:\Windows\Media\Windows Exclamation.wav"     '... chemin et nom à adapter
  ExecuteExcel4Macro ("CALL(""winmm"",""sndPlaySound"",""JCJJ"",""" & MonWav & """, " & 0 & "," & &H1 & ")")
End Sub

'celle ci c'est encore la meme en faisant apel à la meme  api par le biais de la macro 4 et le com intégré a VB
Sub joueBeepWindows3()
Application.ExecuteExcel4Macro "SOUND.PLAY(,""C:\Windows\Media\Windows Exclamation.wav"")"
End Sub

'et ca c'est la petite soeur qui est venu plus tard qui fait appel a la meme DLL mais c'est pas la meme api
Sub joueBeepWindows2ApiBlack()
Dim MonWav As String
    MonWav = "C:\Windows\Media\Windows Exclamation.wav"     '... chemin et nom à adapter
  ExecuteExcel4Macro ("CALL(""winmm"",""PlaySoundA"",""JCJJ"",""" & MonWav & """, " & 0 & "," & &H1 & ")")
End Sub

maintenant tu sais tout ;)
 

Discussions similaires

Réponses
4
Affichages
132
Réponses
2
Affichages
170