[Résolu] Activer et fixer le volume windows

[fabi1joret]

Bonsoir le forum,

J'arrive ce soir avec une drôle de demande...

Je suis à la recherche d'une procédure qui permette d'activer le volume de windows si celui-ci est désactivé et de le fixer à un certain niveau à l'ouverture d'un classeur.
J'ai vu sur la toile qu'il parlait d'API ??? (mais là il me faudrait une "Assistance Pour Inculte")😕

Je précise que je suis sous excel 2013 en 64bits et win8.

Merci pour les réponses

 

[mapomme]

Re : Activer et fixer le volume windows

Bonjour fabi1joret, Bonjour MJ13 🙂,

Je suis complètement hors sujet. Un grand moment d'égarement 🙂. Je vide ce post de son inutile contenu.

 

[MJ13]

Re : Activer et fixer le volume windows

Bonjour Fab, Mapomme

Tu as déjà cette discussion qui pourrait t'aider.

Augmenter et diminuer le son en VBA

Et là de notre ami MichelXLD 🙂.

Utiliser Windows Media Player en VB et VBA

Sinon, Mapomme 🙂, je ne vois pas trop le rapport de ton code avec le son 😕. Ou alors, c'est dans le fichier 😱.

 

[fabi1joret]

Re : Activer et fixer le volume windows

Merci pour les pistes.

J'étudie ça après manger pour en comprendre le fonctionnement et l'adapter.

A bientot

 

[fabi1joret]

Re : Activer et fixer le volume windows

Bon, me revoilà sans avoir trop avancé.

J'ai à peu près compris l'utilisation du windows media player même si je n'est pas trouvé comment ajouter un contrôle ou objet windows media.
Quand au premier fil, ça reste du chinois. J'ai essayé de l'appliquer tel quel dans un userform tel que décrit mais rien ne se passe, même pas un petit message d'erreur. Aurais-je oublié d'activé une référence?

Le but de cette demande, en plus de satisfaire ma curiosité, est de pouvoir faire lire un message par excel à l'ouverture d'un fichier juste pour rappeler à une collègue que ça fait deux semaines qu'on lui réclame les croissants.
J'ai déjà trouvé un bout de code pour lire du texte

Public Vocal As New SpVoice
Public Phrase As Variant
Sub Information(ByVal Phrase As String)
Vocal.Speak Phrase
End Sub
Sub Test_Voix()
Information "A tu pensé au croissant pour té collègue"
End Sub

Mais je voudrais être sur que les hauts parleurs de son ordinateur soit allumer pour qu'elle entende le message.
Je vois bien que c'est possible mais mes connaissances VBAstique ne me permettent pas encore de tout comprendre.

Donc si quelqu'un à un peu de temps à perdre pour m'expliquer tout ça et réussir ma mauvaise blague de bureau, je l'en remercie

 

[david84]

Re : Activer et fixer le volume windows

Bonjour,
à tester :

Option Explicit
'http://www.excelforum.com/excel-programming-vba-macros/363957-api-commands-to-turn-volume-control-on.html
'cocher la dll Microsoft Speech Object Library
Dim Vocal As SpVoice

Const VK_VOLUME_UP = &HAF 

#If Win64 Then
  Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
  ByVal bVk As Byte, ByVal bScan As Byte, _
  ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#Else
  Private Declare Sub keybd_event Lib "user32" ( _
  ByVal bVk As Byte, ByVal bScan As Byte, _
  ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If

Sub VolUp()
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 0, 3, 0
End Sub

Sub Information(ByVal Phrase As String)
Set Vocal = New SpVoice
Vocal.Speak Phrase
End Sub

Sub Test_Voix()
VolUp
Information "A tu pensé au croissant pour tes collègue"
End Sub

Si j'ai bien compris ta demande, le code active les haut-parleurs avant de lancer le message donc si les haut-parleurs sont sur off ils sont activés.
A+

 

[MJ13]

Re : Activer et fixer le volume windows

Re, Bonjour David

Tu peux tester ce code (mais je suis sur Win 8 en 32 bits et Excel 2007 en 32 bits):

Sub Information(ByVal Phrase As String)
  Application.Speech.Speak Phrase
  End Sub
 Sub Test_Voix()
 Information "Bonjour, comment allez-vous?"
 End Sub

Sinon, le code de David 🙂 pour augmenter de volume a l'air de fonctionner.

 

[fabi1joret]

Re : Activer et fixer le volume windows

Re, David, MJ13

C'est parfait. c'est exactement ce que je cherchai. (et plus compréhensible)

Merci à tout les deux pour l'aide.

J'aurais une petite pensée pour le forum quand je dégusterai les croissants avec le café...😉

 

[MJ13]

Re : [Résolu] Activer et fixer le volume windows

Bonjour à tous

Voici un petit fichier pour augmenter ou diminier le volume avec un test de voix 🙂.

 

[paoloadv]

Bonjour,
Sans vouloir déterrer les vieilles haches, j'ai pensé à une solution simple pour fixer le volume à une valeur précise.
En fait, dans le principe, il suffit de faire une boucle sur volDown un nombre de fois suffisant pour être sur d'être à un volume nul. Puis dans une autre boucle, un nombre précis de fois, faire un volUp. Pour savoir combien de fois le volUp doit être lancé depuis sa valeur plancher, il suffit de faire un test au préalable et de voir, en fixant manuellement le volume à fond, en combien de coup j'arrive à le faire tomber à 0. J'ai mesuré (sur ma config) que chaque boucle fait changer le pas de 2 unités de volume affiché sur le mélangeur de volume Microsoft. Il suffit donc de boucler de 1 à n par pas de 2 (ou de 1 à int(n/2)). Cela donne au final...

Option Explicit

#If Win64 Then
  Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#Else
  Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If

Const VK_VOLUME_MUTE = &HAD 'Windows 2000/XP: Volume Mute key
Const VK_VOLUME_DOWN = &HAE 'Windows 2000/XP: Volume Down key
Const VK_VOLUME_UP = &HAF 'Windows 2000/XP: Volume Up key

Sub VolUp()
'-- Turn volumn up --
   keybd_event VK_VOLUME_UP, 0, 1, 0
   keybd_event VK_VOLUME_UP, 0, 3, 0
End Sub

Sub VolDown()
'-- Turn volumn down --
   keybd_event VK_VOLUME_DOWN, 0, 1, 0
   keybd_event VK_VOLUME_DOWN, 0, 3, 0
End Sub

Sub VolToggle()
'-- Toggle mute on / off --
   keybd_event VK_VOLUME_MUTE, 0, 1, 0
End Sub

Sub VolLower()
    ' Met à 0 le volume
    Dim i As Long
    For i = 1 To 50
        VolDown
    Next i
End Sub

Sub VolUpper()
    ' Met à 100 le volume
    Dim i As Long
    For i = 1 To 50
        VolUp
    Next i
End Sub

Sub VolSet(valVolume As Integer)
    ' Positionne le volume à la valeur de 0 à 100
    ' Le pas d'incrément du volume est de 2.
    Dim i As Long, n As Long
    Const pasVol = 2
   
    ' Limitation du volume à une valeur de graduation réelle de 0 à 100
    With Application.WorksheetFunction
        n = .Max(.Min(valVolume, 100), 0)
    End With
    ' On commence par mettre le volume à 0
    VolLower
    ' On monte de pas en pas jusqu'à la valeur de volume n
    For i = 1 To n Step pasVol
        VolUp
    Next i
End Sub

Sub testJouePhrase()
    VolSet (50)
    Call JouePhrase("Hello !")
End Sub

Voilà.
Si cela peut aider certains...
Mais peut-être existe-il encore des solutions simples...
@+
Paolo