Faire jouer une musique mp3 pendant 20 secondes à la fin d'un code VBA

Bonjour à tous,

J'ai un fichier de classement pour un jeu de cartes avec au final un classement et les 3 premiers sur un podium.

Merci à Saboh 12617 et LouReed qui m'ont aidé.

Pour finaliser mon projet, au lancement du classement final, je voudrais qu'une musique se déroule pendant 20 secondes en fin de code.

Mon fichier de classement et un fichier mp3 libre de droits sont joints, mais au final, je vais mettre un autre morceau de musique qui ne le sera peut être pas.

J'ai essayé d'intégrer le code à la fin du code existant, mais ça ne fonctionne pas .

Merci pour votre aide

Robert

Bonjour,

ci-jointe une solution :

26fichier-podium-v3.zip (566.09 Ko)

il vous suffit de saisir le chemin d'accès à votre fichier mp3 dans la constante figurant en tête du module 1.

Bonjour Thev

Ça a fonctionné une foi en me demandant de reconnaitre l'active x, j'ai dit OK

Maintenant, si je relance une session, ça ne fonctionne plus !

Juste une petite question, car il y avait un vide musical, le temps que ça s'initialise.

Si je déplace votre ligne de code en début de macro, est-ce que ça va fonctionner plus tôt ?

Merci pour votre aide

@+

Robert

Bonsoir,

Ajout d'un objet WindowsMediaPlayer sur votre feuille Podium, il est invisible, pour le voir afficher le menu "Volet sélection" :

image

Ceci vous permettra de sélectionner l'objet et de cliquer sur l'oeil pour l'afficher, pour travailler avec il faut dans le menu développeur passer en mode création, mais ce n'est pas utile...

Ensuite ajout de code pour télécharger dans cet objet la musique voulue, avec une tempo de 20 seconde par une boucle Do DoEvents Loop While.
A l'issue de la boucle on stoppe la lecture de la musique.

Ajout de l'arrêt de lecture de la musique si l'on quitte la feuille Podium.

Le fichier :

17free-dog-coupe.zip (1.05 Mo)

@ bientôt

LouReeD

PS : thev : votre fichier plante chez moi, mémoire insuffisante + erreur 22245587452 (chiffre aléatoire je n'ai pas pris le temps de le relevé)

Ça a fonctionné une fois

Effectivement, il y a un problème de réinitialisation de l'ActiveX Windows Media Player. Je regarde et corrige.

Voir également la solution de LouReed que je salue.

Bonsoir,

une autre façon de faire, solution de Patrick de Toulon !

Il faut modifier le chemin de la musique, et le code crée un VBS de lecture de son :

28musique.xlsm (18.38 Ko)

@ bientôt

LouReeD

Bonsoir,

ci-joint fichier corrigé avec ajout d'une constante en tête du module 1, pour la durée de déroulement de la musique

26fichier-podium-v4.zip (566.91 Ko)

pour éviter le message d'avertissement ActiveX, vous pouvez effectuer cette modification du registre

14officeactivex.zip (505.00 Octets)

Bonjour à tous

Merci pour vos supers fichiers.

LouReed

Ça fonctionne très bien. J'ai remplacé le morceau de musique, ajouté du temps et c'est OK

Bien entendu, il faut que j'analyse et que je comprenne le code. Car pour moi, utiliser un code sans le comprendre n'est pas sérieux.

thev

Ça fonctionne également très bien.

Hors de question que je touche au registre. Je ne suis pas assez qualifié.

Mon soucis, est qu'il n'est pas possible de copier l' Userform média dans mon fichier final, et je ne comprends pas comment le construire.

Je vais donc essayer d'intégrer la solution de LouReed dans mon fichier final.

Pour info et amusement, hier j'ai pris en photo 2 de mes 4 petits enfants, je les ai mis dans le fichier et j'ai coupé la musique sur 30 secondes de Europa titre The final countdown au centième de seconde près et ça rend super bien.

Ils étaient heureux d'apparaitre sur le podium. Comme quoi, un Papy s'amuse bien avec ces petits garnements

Merci à vous deux pour votre précieuse aide

Bonne journée

Robert

Bonjour,

Mon soucis, est qu'il n'est pas possible de copier l' Userform média dans mon fichier final, et je ne comprends pas comment le construire.

il vous suffit de placer ces 2 fichiers dans le même répertoire

15formulaire-musique.frm (786.00 Octets)

puis d'importer dans l'éditeur Visual Basic, le fichier : formulaire_musique.frm, via clic droit sur VBAProject

Hors de question que je touche au registre. Je ne suis pas assez qualifié.

Vous n'avez pas à toucher au registre. il vous suffit de double-cliquer sur le fichier .reg contenu dans l'archive ci-jointe et la modification sera effectuée

12officeactivex.zip (505.00 Octets)

Hello,

A noter que l'on a pas besoin d'utiliser un ActiveX pour utiliser windows media player, on peut directement créer l'object COM en VBA .

Exemple d'utilisation dans le code de fichier-podium-v2.xlsm :

Public Sub MAJClt()
    Dim OWMP As Object
    If OWMP Is Nothing Then
    Set OWMP = CreateObject("new:WMPlayer.OCX.7")
    End If
    OWMP.settings.autoStart = True
    OWMP.Url = ThisWorkbook.Path & "\Free_Dog-coupé.mp3"

' Code de Saboh12617 Excel-pratique
  ' recuperation des images dans le tableau de score
  Dim podiumPics(1 To 3) As Shape
  Dim i As Long, shp As Shape
  With Feuil3.ListObjects("tblClt").ListColumns(4).DataBodyRange
    For i = LBound(podiumPics) To UBound(podiumPics)
      For Each shp In Feuil3.Shapes
        If shp.TopLeftCell.Address = Feuil3.Cells(.Cells(i).Value2, 2).Address Then
          Set podiumPics(i) = shp
          Exit For
        End If
      Next shp
    Next i
  End With
  ' suppression des anciennes
  For Each shp In Feuil4.Shapes
    If shp.Name Like "Joueur_*" Then shp.Delete
  Next shp
  ' ajout des nouvelles images
  Dim positions(1 To 3, 0 To 1) As Double
  positions(1, 0) = 201.750152587891: positions(1, 1) = 2           ' OR
  positions(2, 0) = 107.249366760254: positions(2, 1) = 52          ' ARGENT
  positions(3, 0) = 311.250152587891: positions(3, 1) = 55          ' BRONZE
' Données d'origine
' positions(1, 0) = 201.750152587891: positions(1, 1) =              Donnée à modifier pour la hauteur du personnage 0#
' positions(2, 0) = 107.249366760254: positions(2, 1) = 19.5
' positions(3, 0) = 311.250152587891: positions(3, 1) = 51.75

  For i = 1 To 3
    podiumPics(i).Copy
    Feuil4.Paste Feuil4.Range("A1")
    With Feuil4.Shapes(Feuil4.Shapes.Count)
      If .TopLeftCell.Address(False, False) = "A1" Then
        .Name = "Joueur_" & i
        .Left = positions(i, 0)
        .Top = positions(i, 1)
      End If
    End With
  Next i

  Feuil4.Activate
  Feuil4.Range("C8").Activate

  ' Temporisation 20 seconde
  tempo = Timer
  Do
    DoEvents
  Loop While tempo + 20 > Timer
  OWMP.Controls.stop  
End Sub

Ami calmant, J.P

Bonjour,
Jurassic Pork bonjour,

je vois que l'objet WMP est plus simple à créer que l'objet VBS ! merci pour cela !
Il faut que je me le mette de côté pour mes futurs applications !
Peut on créer plusieurs objets afin de pouvoir lancer une lecture simultanée de musique ?

@ bientôt

LouReeD

Hello LouReed,

houla "une lecture simultanée de musique" c'est pour quoi faire ? mixer des pistes instrumentales ? ça risque de ne pas être trop synchronisé.

Ami calmant, J.P

Mon application "Machine à sous" joue une musique de fond, d'ambiance alors que la machine à sous joue différent bruitage plus ou moins long, donc j'ai intégré autant d'objet WMP sur une feuille et je télécharge les musiques à l'ouverture du fichier, ensuite je fait jouer le ou les morceaux voulu en les appelant indifféremment.
Votre idée de création d'objet en "live" me permettrait de ne plus avoir cette feuille avec ces objets, Je crée à l'ouverture un tableau d'objet et je télécharge dans chacun d'eux la musique voulue, ensuite je n'ai plus qu'à gérer ce tableau.

Mon application plus récente "ArkaLouReeD" utilise la même technique pour tout ce qui est bruitage.

@ bientôt

LouReeD

Voici un code qui joue une musique en fond et qui joue "par dessus" 9 sons système :

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Private OWMP As Object ' Objet déclaré en global pour qu'il ne soit pas détruit à la fin de la routine
Sub JoueSons()
    ' Test J.P  Mars 2025
    Dim OWMP2 As Object
    If OWMP Is Nothing Then
          Set OWMP = CreateObject("new:WMPlayer.OCX.7")
    End If
    OWMP.settings.autoStart = True
    OWMP.Url = "D:\zic\EyeInTheSky.mp3"
    Set OWMP2 = CreateObject("new:WMPlayer.OCX.7")
    OWMP2.settings.autoStart = True
    Alarms = Array("alarm01.Wav", "alarm02.wav", "alarm03.wav", _
              "alarm04.wav", "alarm05.wav", "alarm06.wav", _
              "alarm07.wav", "alarm08.wav", "alarm09.wav")
    For Each Alarm In Alarms
      Debug.Print Alarm
      OWMP2.Url = "C:\Windows\Media\" + Alarm
      Do While Not OWMP2.playState = 1 ' on boucle tant que l'état n'est pas à "Stoppé"
        DoEvents
        Sleep 100 'tempo de 100 ms pour ne pas "manger le CPU"
      Loop
    Next
    Set OWMP2 = Nothing
  ' OWMP.Controls.stop ' A mettre si on veut que la musique s'arrête
End Sub
Rechercher des sujets similaires à "jouer musique mp3 secondes fin code vba"