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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Non, celui de Laeticia car la syntaxe à l'air plus complexe que simplement Beep. Essayez :
VB:
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Sub Form_Activate()
    Dim Cnt As Long
    For Cnt = 0 To 100 Step 10
        'play a tone of 'Cnt' hertz, for 50 milliseconds
        Beep Cnt, 200
        DoEvents
    Next Cnt
End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Ecrit et testé pour 2003 , voir post #5 :
( testé sur 2007, ça marche )
 

Pièces jointes

  • Copie de Bip(1).xls
    50 KB · Affichages: 3

soan

XLDnaute Barbatruc
Bonjour l'internaute, sylvanu,

J'ai vu que tu as Excel 2003 ; comme sylvanu, j'ai Excel 2007 ; si un intervenant qui utilise cette ancienne version peut tester sur Excel 2003, ça aidera peut-être ?

Autre piste : as-tu bien vérifié que tes 2 haut-parleurs sont correctement branchés ? peut-être qu'un câble n'est pas bien mis ? des fois, il semble bien connecté, mais comme il sort un petit peu, ça ne se voit pas ; et bien sûr, de façon logicielle, le son ne doit pas être désactivé, comme c'est le cas sur cette image :​

Image.jpg


edit : sylvanu dit qu'il a testé sur Excel 2003 et Excel 2007.

soan
 

un internaute

XLDnaute Occasionnel
Bonsoir sylvanu & soan,
Oui le son fonctionne très bien il est même à fond
Si je pouvais joindre un fichier ça serait le mieux mais alors là il y a de la casse!!
Ce qui est curieux c'est que Logoff.wav fonctionne très bien... mais alors le "boucan" !!!
Merci à vous deux
 

Dranreb

XLDnaute Barbatruc
Bonsoir.
Spécifiez le second paramètre au MsgBox. En effet vbExclamation, vbInformation, vbQuestion et vbCritical changent le son.
En dehors du cadre des Msgbox il y a aussi ça :
VB:
Private Declare Function MessageBeep Lib "user32.dll" (ByVal wType As Long) As Long
qui accepte précisément ces constantes VbMsgBoxStyle en guise d'argument.
 

Discussions similaires

Haut Bas