Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

[VBA][Excel 2016] Changement automatique d'imprimante (pour Denis !!!)

5 réponses
Avatar
ThierryP
Bonjour le forum,

Il y a quelque temps, l'incontournable Denis (MichD) m'avait concoct=C3=A9 =
une macro pour changer automatiquement d'imprimante, avec Excel 2013 et Win=
dows 7.

Aujourd'hui, me voici sous Windows 10 et Excel 2016 et bien s=C3=BBr, cette=
macro ne fonctionne plus !

Voici le code :

Appel de la macro :

Private Sub Worksheet_Activate()
Travaux.Hide
ActiveSheet.ScrollArea =3D "A1:Y" & ActiveSheet.Range("A1000").End(xlUp).Ro=
w + 2
'---------- Changement Imprimante ---------------
SonNom =3D "\\VMSERVTS01\Copieur_Couleur"
ImprimanteD=C3=A9sir=C3=A9e =3D Mon_Imprimante(SonNom)
ChangeImprimanteParD=C3=A9faut ImprimanteD=C3=A9sir=C3=A9e
End Sub

Sub ChangeImprimanteParD=C3=A9faut(Imprimante)
Dim WshNetwork, oPrinters, I, DefPrinter
DefPrinter =3D Application.ActivePrinter
Set WshNetwork =3D CreateObject("WScript.Network")
Set oPrinters =3D WshNetwork.EnumPrinterConnections
For I =3D 0 To oPrinters.Count - 1 Step 1
If InStr(1, Imprimante, oPrinters.Item(I + 1), vbTextCompare) =3D 1 The=
n
WshNetwork.SetDefaultPrinter oPrinters.Item(I + 1)
Exit Sub
End If
Next
End Sub

Function Mon_Imprimante(SonNom As String)
Dim A As Integer, Temp As String
Dim objDictionary As Object, strComputer As String
Dim objWMIService As Object, colPrinters As Object
Dim objprinter As Object
Set objDictionary =3D CreateObject("Scripting.Dictionary")
strComputer =3D "."
Set objWMIService =3D GetObject("winmgmts:" _
& "{impersonationLevel=3Dimpersonate}!\\" & strComputer & "\root\cimv2"=
)
Set colPrinters =3D objWMIService.ExecQuery _
("Select * from Win32_Printer")
For Each objprinter In colPrinters
Temp =3D objprinter.Name & " sur " & objprinter.PortName
If InStr(1, Temp, SonNom, vbTextCompare) > 0 Then
Mon_Imprimante =3D Temp
Exit For
End If
Next
End Function

La fonction ne renvoie rien, donc la suite plante.

Donc si quelqu'un conna=C3=AEt la syntaxe pour W10 et Excel2016, je suis pr=
eneur !

Merci d'avance,

ThierryP

5 réponses

Avatar
MichD
Bonjour,
J'ai fait un test rapide le la fonction, elle fonctionne correctement
même sous Windows 10, 64 bits.
Vérifie ces lignes dans ton code :
SonNom = "VMSERVTS01Copieur_Couleur"
ImprimanteDésirée = Mon_Imprimante(SonNom)
Est-ce que la variable "SonNom" contient un nom d'imprimante présent
dans Windows 10? Pour ce faire, saisis "Imprimante" dans la zone de
recherche près du bouton démarrer, la fenêtre "Imprimantes et Scanneurs"
s'affichera, là, où la liste des noms des imprimantes installées
disponibles.
Si la variable n'est pas bien renseignée, il est normal que la fonction
retourne "".
MichD
Le 26/06/19 à 05:16, ThierryP a écrit :
Bonjour le forum,
Il y a quelque temps, l'incontournable Denis (MichD) m'avait concocté une macro pour changer automatiquement d'imprimante, avec Excel 2013 et Windows 7.
Aujourd'hui, me voici sous Windows 10 et Excel 2016 et bien sûr, cette macro ne fonctionne plus !
Voici le code :
Appel de la macro :
Private Sub Worksheet_Activate()
Travaux.Hide
ActiveSheet.ScrollArea = "A1:Y" & ActiveSheet.Range("A1000").End(xlUp).Row + 2
'---------- Changement Imprimante ---------------
SonNom = "VMSERVTS01Copieur_Couleur"
ImprimanteDésirée = Mon_Imprimante(SonNom)
ChangeImprimanteParDéfaut ImprimanteDésirée
End Sub
Sub ChangeImprimanteParDéfaut(Imprimante)
Dim WshNetwork, oPrinters, I, DefPrinter
DefPrinter = Application.ActivePrinter
Set WshNetwork = CreateObject("WScript.Network")
Set oPrinters = WshNetwork.EnumPrinterConnections
For I = 0 To oPrinters.Count - 1 Step 1
If InStr(1, Imprimante, oPrinters.Item(I + 1), vbTextCompare) = 1 Then
WshNetwork.SetDefaultPrinter oPrinters.Item(I + 1)
Exit Sub
End If
Next
End Sub
Function Mon_Imprimante(SonNom As String)
Dim A As Integer, Temp As String
Dim objDictionary As Object, strComputer As String
Dim objWMIService As Object, colPrinters As Object
Dim objprinter As Object
Set objDictionary = CreateObject("Scripting.Dictionary")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!" & strComputer & "rootcimv2")
Set colPrinters = objWMIService.ExecQuery _
("Select * from Win32_Printer")
For Each objprinter In colPrinters
Temp = objprinter.Name & " sur " & objprinter.PortName
If InStr(1, Temp, SonNom, vbTextCompare) > 0 Then
Mon_Imprimante = Temp
Exit For
End If
Next
End Function
La fonction ne renvoie rien, donc la suite plante.
Donc si quelqu'un connaît la syntaxe pour W10 et Excel2016, je suis preneur !
Merci d'avance,
ThierryP
Avatar
MichD
Dans la fenêtre "Imprimantes et Scanneurs", je viens de voir qu'il y a
une option "Laisser Windows choisir mon imprimante par défaut". Si cette
case est cochée, peut-on modifier par code l'imprimante par défaut
différent de celle que Windows a identifiée? Cette option n'existait pas
sous les versions antérieures de Windows. Comme je n'utilise plus Excel
beaucoup, je n'ai pas l'occasion de tester ces choses-là!
MichD
Avatar
ThierryP
Bonjour Denis,
Pour quelqu'un qui souhaitait prendre un peu de recul, je vois que tu es to ujours aussi présent :-), tant mieux pour nous !!!
Cette option est bien décochée sur mon poste.
ThierryP
Le mercredi 26 juin 2019 13:30:28 UTC+2, MichD a écrit :
Dans la fenêtre "Imprimantes et Scanneurs", je viens de voir qu'il y a
une option "Laisser Windows choisir mon imprimante par défaut". Si c ette
case est cochée, peut-on modifier par code l'imprimante par déf aut
différent de celle que Windows a identifiée? Cette option n'exi stait pas
sous les versions antérieures de Windows. Comme je n'utilise plus Ex cel
beaucoup, je n'ai pas l'occasion de tester ces choses-là!
MichD
Avatar
MichD
Et la fonction, ne fonctionne toujours pas?
MichD
Le 26/06/19 à 08:48, ThierryP a écrit :
Bonjour Denis,
Pour quelqu'un qui souhaitait prendre un peu de recul, je vois que tu es toujours aussi présent :-), tant mieux pour nous !!!
Cette option est bien décochée sur mon poste.
ThierryP
Le mercredi 26 juin 2019 13:30:28 UTC+2, MichD a écrit :
Dans la fenêtre "Imprimantes et Scanneurs", je viens de voir qu'il y a
une option "Laisser Windows choisir mon imprimante par défaut". Si cette
case est cochée, peut-on modifier par code l'imprimante par défaut
différent de celle que Windows a identifiée? Cette option n'existait pas
sous les versions antérieures de Windows. Comme je n'utilise plus Excel
beaucoup, je n'ai pas l'occasion de tester ces choses-là!
MichD
Avatar
ThierryP
Si si , je te rassure, tout fonctionne maintenant !
ThierryP
Le mercredi 26 juin 2019 15:03:14 UTC+2, MichD a écrit :
Et la fonction, ne fonctionne toujours pas?
MichD