Microsoft 365 macro imprimante

P

pagoulet

XLDnaute Nouveau
Bonjour vous tous,

j'ai un blanc de mémoire.

J'ai créé une macro pour imprimer, tout fonctionne bien, mais elle ne revient pas à mon imprimante par défaut. Elle reste sur l'imprimante que j'ai sélection.

Est-ce que vous un exemple de code macro complet pour désigner d'imprimer sur une imprimante et de revenir sur l'imprimante par défaut ou le nom de l'imprimante qu'on veut qu'elle revienne.

Merci!
 
Trier par date Trier par votes
E

Eric KERGRESSE

XLDnaute Occasionnel
Bonjour,

Vous pourriez utiliser ce code :
VB: 
Dim sDefaultPrinter As String
 
    sDefaultPrinter = Application.ActivePrinter  ' Votre imprimante par défaut
    Application.ActivePrinter = "XXXX"           ' Le nom de l'imprimante choisie
 
    ' Suite du code .....
 
    Application.ActivePrinter = sDefaultPrinter  ' Pour revenir sur l'imprimante par défaut
 
Vote positif 0 Vote négatif
E

Eric KERGRESSE

XLDnaute Occasionnel
Re bonjour à tous,

Désolé pour ce code foireux... 🥵 car il faut indiquer le port de l'imprimante. Voilà ce que j'ai recherché sur les différents forums.

Le code ci-dessous liste les imprimantes et leur statut :
VB: 
Sub ListeImprimantes_et_Statut()

Dim objWMIService As Object, colInstalledPrinters As Object, objPrinter As Object
Dim NomPC As String, Resultat As String
 
    NomPC = "."
   
    Set objWMIService = GetObject("winmgmts:" & _
        "{impersonationLevel=impersonate}!\\" & NomPC & "\root\cimv2")
    Set colInstalledPrinters = objWMIService.execQuery("Select * from Win32_Printer")
   
    For Each objPrinter In colInstalledPrinters
        With objPrinter
             Resultat = Resultat & .name & " imprimante active : " & .Default & vbLf
        End With
    Next
   
    MsgBox Resultat
    Debug.Print Resultat
   
End Sub

Le soucis, c'est qu'on n'a pas le port. J'ai donc recherché un code sur les différents forums. Un début de solution m'a été donné par une réponse de Philippe TULLIEZ 🤝 qui renvoyait sur un message d'un forum.
J'ai transformé la fonction proposée par la sub suivante :
Code: 
Sub PrinterListForExcel() 'Optional linkword As String = "sur")
   
Dim i As Integer, j As Integer, s As String, prtcons
Dim PrinterList() As String
 
    Set prtcons = CreateObject("WScript.Network").EnumPrinterConnections
    ReDim PrinterList(0 To (prtcons.Count - 1) \ 2)
    j = 0
    For i = 0 To (prtcons.Count - 1) \ 2
        s = ""
        If prtcons(i * 2) = "nul:" Then
            s = "nul:"
        Else
            s = "Ne" & Format(j, "00") & ":"
            j = j + 1
        End If
      '  PrinterList(i) = prtcons(i * 2 + 1) & " " & linkword & " " & s
        PrinterList(i) = prtcons(i * 2 + 1) & " sur " & s
        Debug.Print PrinterList(i)
    Next
End Sub

Sauf que chez moi le code est foireux. Il donne bien une valeur mais le port indiqué est décalé (un numéro trop haut), là où on m'indique 03 pour un port, celui-ci est le 02 en réalité.

Sachant cela, j'ai pu modifier mon imprimante active avec ce code :
Code: 
Sub LancerLImpression()
 
Dim sDefaultPrinter As String
 
    With Application
   
         sDefaultPrinter = .ActivePrinter  ' Votre imprimante par défaut
   
         .ActivePrinter = "Microsoft Print to PDF sur Ne03:"  ' C'est mon imprimante par défaut
         Debug.Print .ActivePrinter
     
         .ActivePrinter = "PDF Architect 7 sur Ne01:"         ' Le nom de l'imprimante choisie
         Debug.Print .ActivePrinter
     
         .ActivePrinter = "Microsoft Print to PDF sur Ne03:"  ' Je reviens sur l'imprimante par défaut
        Debug.Print .ActivePrinter
   
    End With
   
End Sub

En résumé, il vous faut trouver le bon port. Les Debug.Print vous aideront à récupérer vos imprimantes. Il vous faut ensuite les mettre dans une table avec les bons ports pour vous en resservir par la suite.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour bonjour
pas mal l'idée Eric mais le resultat est faux
1702210171280.png


il est non seulement décalé mais faux aussi
regarde bien la capture de la base de registre
base de registre qui peut être lu par vba d'ailleurs ;)
j'en ai une avec les api si vous voulez
 
Vote positif 0 Vote négatif
E

Eric KERGRESSE

XLDnaute Occasionnel
Salut Patrick,

J'ai bien indiqué que le code était foireux et je n'ai pas été plus loin. Je voulais trouver une solution pour référencer automatiquement Wscript.Network, et instancier une variable de ce type pour lire les propriétés avec l'intellisens.

Sinon, tu fais comment pour récupérer directement le port ?
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
j'ai essayé avec
WMI (choux blanc ,je recupère tout un tas de truc sur l'imprimante sauf ça)
Wscript.Network (je pense pas que l'on puisse récupérer cette properties)

avec les api lecture du registre de la cle ci dessous oui
"HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Devices

si j'arrivais a me rapeller comment on lit les valeur deword en boucle avec createobject("wscript.shell").regread
je vous le fait sans api avec ça
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
api adaptées en 64
VB: 
'******************************************************************************************************************************************************
'    ___      _     _______  __      _    ____  _   _  _______  ___      _   _    _    ___      _     _.
'   //  \\   /\\      //    // \\   //   //    //  //    //    //  \\   //  //   //   //  \\   //|   //
'  //___//  //__\    //    //__//  //   //    //__||    //    //   //  //  //   //   //   //  // |  //
' //       //   \\  //    //  \\  //   //    //  \\    //    //   //  //  //   //   //   //  //  | //
'//       //    // //    //   // //   //___ //    \\  //     \\__//  //__//   //___ \\__//  //   |//
'******************************************************************************************************************************************************
'fonction pour lister les imprimantes pour excel
'patricktoulon sur vdeloppez.com
'date 16/12/2017
'mise à jour :10/12/2023
'api en 64
Option Explicit
'32bit'Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal HKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long
'32bits'Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal HKey As Long, ByVal dwIndex As Long, ByVal lpPrinterName As String, lpcbPrinterName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As LongPtr, lpType As Long, lpData As Byte, lpcbData As Long) As Long
'32bits'Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = &H103
Private Const ERROR_MORE_DATA = &HEA

Sub test()
    Dim t, i&
    t = GetPrintersList
    MsgBox Join(t, vbCrLf)
End Sub

Public Function GetPrintersList() As String()
    Dim Printers$(), PrinterIndex&, hKey As LongPtr, Res&, IndexKey&, PrinterName$, LenName&, DataType&, ValueValue() As Byte, i&, t$, a&, b&: t = ""
    PrinterIndex = 0
    IndexKey = 0
    PrinterName = String$(256, Chr(0))
    LenName = 255
    ReDim ValueValue(0 To 500)
    ReDim Printers(1 To 20) 'jusqu'a 20 imprimantes
     Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, KEY_QUERY_VALUE, hKey)
    Res = RegEnumValue(hKey, IndexKey, PrinterName, LenName, 0&, DataType, ValueValue(0), 1000)
    Do Until Res = ERROR_NO_MORE_ITEMS
        PrinterName = Split(PrinterName, Chr(0))(0)
        a = InStr(1, ValueValue, ","): b = InStr(1, ValueValue, ":") 'recherche de la virgule et du doublepoint
        For i = a To b: t = t & Chr(ValueValue(i)): Next 'récupération du texte dans le tableau de bytes
        If Trim(t) = "" Then t = " Null"
        PrinterIndex = PrinterIndex + 1
        Printers(PrinterIndex) = Application.Trim(PrinterName & " sur " & t)
        PrinterName = String(255, Chr(0))
        LenName = 255
        ReDim ValueValue(0 To 500)
        IndexKey = IndexKey + 1
        Res = RegEnumValue(hKey, IndexKey, PrinterName, LenName, 0&, DataType, ValueValue(0), 1000) 'on change la cle pour le prochain Do
         If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then Exit Do
    Loop
    ReDim Preserve Printers(1 To PrinterIndex)
    Res = RegCloseKey(hKey)
    GetPrintersList = Printers
End Function
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
ca a planté sur microsoft print pdf sur Ne00
d'ailleur c'est une erreur j'ai fait un oubli en réécrivant la fonction
voilà maintenant ça fonctionne
sauf bien entendu quand le port est "Null"

mille excuse pour l'oubli du vidage de la variable "t"
VB: 
'******************************************************************************************************************************************************
'    ___      _     _______  __      _    ____  _   _  _______  ___      _   _    _    ___      _     _.
'   //  \\   /\\      //    // \\   //   //    //  //    //    //  \\   //  //   //   //  \\   //|   //
'  //___//  //__\    //    //__//  //   //    //__||    //    //   //  //  //   //   //   //  // |  //
' //       //   \\  //    //  \\  //   //    //  \\    //    //   //  //  //   //   //   //  //  | //
'//       //    // //    //   // //   //___ //    \\  //     \\__//  //__//   //___ \\__//  //   |//
'******************************************************************************************************************************************************
'fonction pour lister les imprimantes pour excel
'patricktoulon sur vdeloppez.com
'date 16/12/2017
'mise à jour :10/12/2023
'api en 64
Option Explicit
'32bit'Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal HKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long
'32bits'Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal HKey As Long, ByVal dwIndex As Long, ByVal lpPrinterName As String, lpcbPrinterName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As LongPtr, lpType As Long, lpData As Byte, lpcbData As Long) As Long
'32bits'Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = &H103
Private Const ERROR_MORE_DATA = &HEA

Sub test()
    Dim t, i&
    t = GetPrintersList
    MsgBox Join(t, vbCrLf)
End Sub


Sub test2()
    Dim t, i&
    t = GetPrintersList
    MsgBox Join(t, vbCrLf)
    For i = LBound(t) To UBound(t)
       If Not t(i) Like "*Nul*" Then Application.ActivePrinter = t(i)
       MsgBox Application.ActivePrinter
    Next i
   
End Sub


Public Function GetPrintersList() As String()
    Dim Printers$(), PrinterIndex&, hKey As LongPtr, Res&, IndexKey&, PrinterName$, LenName&, DataType&, ValueValue() As Byte, i&, t$, a&, b&: t = ""
    PrinterIndex = 0
    IndexKey = 0
    PrinterName = String$(256, Chr(0))
    LenName = 255
    ReDim ValueValue(0 To 500)
    ReDim Printers(1 To 20) 'jusqu'a 20 imprimantes
     Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, KEY_QUERY_VALUE, hKey)
    Res = RegEnumValue(hKey, IndexKey, PrinterName, LenName, 0&, DataType, ValueValue(0), 1000)
    Do Until Res = ERROR_NO_MORE_ITEMS
        PrinterName = Split(PrinterName, Chr(0))(0)
        a = InStr(1, ValueValue, ","): b = InStr(1, ValueValue, ":") 'recherche de la virgule et du doublepoint
        t = ""
        For i = a To b: t = t & Chr(ValueValue(i)): Next 'récupération du texte dans le tableau de bytes
        If Trim(t) = "" Then t = " Null"
        PrinterIndex = PrinterIndex + 1
        Printers(PrinterIndex) = Application.Trim(PrinterName & " sur " & t)
        PrinterName = String(255, Chr(0))
        LenName = 255
        ReDim ValueValue(0 To 500)
        IndexKey = IndexKey + 1
        Res = RegEnumValue(hKey, IndexKey, PrinterName, LenName, 0&, DataType, ValueValue(0), 1000) 'on change la cle pour le prochain Do
         If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then Exit Do
    Loop
    ReDim Preserve Printers(1 To PrinterIndex)
    Res = RegCloseKey(hKey)
    GetPrintersList = Printers
End Function
c'est bon pour moi

demo.gif
 
Dernière édition:
Vote positif 1 Vote négatif
E

Eric KERGRESSE

XLDnaute Occasionnel
Super Patrick 👍

Après adaptation de ton code pour répondre à la demande d'origine :
VB: 
Sub test3()

Dim t, i&
  
    Application.ActivePrinter = "Microsoft Print to PDF sur Ne03:" ' L'imprimante par défaut
    Debug.Print Application.ActivePrinter
  
    t = GetPrintersList
    For i = LBound(t) To UBound(t)
       If Not t(i) Like "*Nul*" And InStr(1, t(i), "HP8B643A", vbTextCompare) > 0 Then 'Le nom de l'imprimante commence par
          Application.ActivePrinter = t(i)
          Exit For
       End If
    Next i
    Debug.Print Application.ActivePrinter
    Application.ActivePrinter = "Microsoft Print to PDF sur Ne03:" ' L'imprimante par défaut
    Debug.Print Application.ActivePrinter
 
End Sub

Plutôt qu'une Sub, une fonction serait plus adaptée avec comme paramètres, l'imprimante par défaut et l'imprimante choisie.
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Autres Générer une étiquette pour imprimante thermique
Réponses
3
Affichages
472
fanch55
fanch55
micheldu52
  • Question
Microsoft 365 Publipostage WORD
Réponses
2
Affichages
787
vgendron
vgendron
Y
  • Résolu(e)
XL 2021 Macro pour imprimer un document
Réponses
2
Affichages
813
Yoan_VBA
Y
C
  • Résolu(e)
XL 2021 Userform impression + choix des feuilles
Réponses
8
Affichages
262
candido57
C
E
  • Résolu(e)
Microsoft 365 Filtre sur LISTBOX
2
Réponses
16
Affichages
726
eric72
E
C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
522
candido57
C
L
  • Question
Microsoft 365 Erreur "Excel a manqué de ressources..." avec macro
Réponses
3
Affichages
1 K
AtTheOne
AtTheOne
merinos-BernardEtang
  • Résolu(e)
Microsoft 365 VBA: ne travailler qu'avec les TABLES
Réponses
3
Affichages
184
merinos-BernardEtang
merinos-BernardEtang
ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
425
ph.vanne
ph.vanne
micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
304
micie1509
micie1509

Membres actuellement en ligne

13 membres et 79 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 088
Messages
2 116 089
Membres
112 658
dernier inscrit
doro 76