Microsoft 365 macro imprimante

pagoulet · 8 Décembre 2023

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!

patricktoulon · 10 Décembre 2023

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

patricktoulon · 11 Décembre 2023

oupss j'enlevais le doublepoint dans le nom
voila tout testé c'est ok

VB:

'******************************************************************************************************************************************************
'    ___      _     _______  __      _    ____  _   _  _______  ___      _   _    _    ___      _     _.
'   //  \\   /\\      //    // \\   //   //    //  //    //    //  \\   //  //   //   //  \\   //|   //
'  //___//  //__\    //    //__//  //   //    //__||    //    //   //  //  //   //   //   //  // |  //
' //       //   \\  //    //  \\  //   //    //  \\    //    //   //  //  //   //   //   //  //  | //
'//       //    // //    //   // //   //___ //    \\  //     \\__//  //__//   //___ \\__//  //   |//
'******************************************************************************************************************************************************
'fonction pour lister les imprimantes pour excel
'patricktoulon sur devellopez.com
'date 16/12/2017
'Version 1.0
'mise à jour :10/12/2023 sur Exceldownloads
'api en 64
'mise a jour 10/12/2023s ur Exceldownloads
'on passe en mode récursifpour l'enumération
'version 2.0
'*****************************************************************************************************************
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

Public Function GetPrintersListV2(Optional IndexKey As Long = 0) As Variant
    Dim hKey As LongPtr, Res&, PrinterName$, DataType&, ValueValue() As Byte, i&, tx$, t$, a&, b&
    Static printers$(): Static indx As Long
    PrinterName = String$(256, Chr(0)): ReDim ValueValue(0 To 999): If IndexKey = 0 Then ReDim printers(1 To 1): indx = 0
    RegOpenKeyEx HKCU, PRINTER_KEY, 0&, KEY_QUERY_VALUE, hKey
    RegEnumValue hKey, IndexKey, PrinterName, Len(PrinterName), 0&, DataType, ValueValue(0), 1000: RegCloseKey hKey
    PrinterName = Split(PrinterName, Chr(0))(0)
    If Trim(PrinterName) <> "" Then
        t = StrConv(ValueValue, vbUnicode): a = InStr(1, t, ","): b = InStr(1, t, ":")
        tx = "": For i = a + 1 To b: tx = tx & Mid(t, i, 1): Next:
        indx = indx + 1: ReDim Preserve printers(1 To indx): printers(indx) = PrinterName & " sur " & tx
        Debug.Print PrinterName & " sur " & tx
        GetPrintersListV2 IndexKey + 1
    End If
    If IndexKey = 20 Then Exit Function    ' au pire des cas on sort  au bout de 20 essais
    GetPrintersListV2 = printers:
End Function


Sub test3()
    Dim t, i&
    t = GetPrintersListV2
   ' 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


Sub TestImprimanteChoisie()

    ImprimanteChoisie ("HP8B643A")                ' Même avec un nom partiel de l'imprimante
    Debug.Print Application.ActivePrinter
  
    ' .... Suite du code
  
    ImprimanteChoisie ("Microsoft Print to PDF")  ' Mon imprimante par défaut
    Debug.Print Application.ActivePrinter

End Sub


Sub ImprimanteChoisie(ByVal NomImprimante As String)

Dim t, i&
  
    t = GetPrintersList
    For i = LBound(t) To UBound(t)
       If Not t(i) Like "*Nul*" And InStr(1, t(i), NomImprimante, vbTextCompare) > 0 Then 'Le nom de l'imprimante commence par
          Application.ActivePrinter = t(i)
          Exit For
       End If
    Next i
 
End Sub

Eric KERGRESSE · 8 Décembre 2023

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

pagoulet · 9 Décembre 2023

Non ça ne fonctionne pas :-(

patricktoulon · 9 Décembre 2023

bonjour
normalement la macro de Eric devrait fonctionner
cela dit ne pas confondre l'imprimante par defaut de Excel et l'imprimante par defaut de Windows
ce sont deux choses différentes
on parle d'imprimer quoi?

pagoulet · 9 Décembre 2023

une feuille excel

patricktoulon · 9 Décembre 2023

alors
soit tu n'a pas d'imprimante configurées tu es en wps out soit tu fait mal quelque chose
soit ton excel est en vrac

Eric KERGRESSE · 10 Décembre 2023

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.

patricktoulon · 10 Décembre 2023

Bonjour bonjour
pas mal l'idée Eric mais le resultat est faux

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

Eric KERGRESSE · 10 Décembre 2023

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 ?

patricktoulon · 10 Décembre 2023

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

patricktoulon · 10 Décembre 2023

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

Eric KERGRESSE · 10 Décembre 2023

Patrick,

Qu'est-ce que donne ton test comme ceci chez toi ?

VB:

Sub test()
    Dim t, i&
    t = GetPrintersList
   ' MsgBox Join(t, vbCrLf)
    For i = LBound(t) To UBound(t)
       Application.ActivePrinter = t(i)
       MsgBox Application.ActivePrinter
    Next i
    
End Sub

patricktoulon · 10 Décembre 2023

mais je renonce pas a la methode wscript.shell
je m'en servait il y a une 20 aines 'années

Effectuez une recherche sur Excel Downloads...

Microsoft 365 macro imprimante

pagoulet

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Eric KERGRESSE

XLDnaute Occasionnel

pagoulet

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

pagoulet

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Eric KERGRESSE

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Eric KERGRESSE

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Eric KERGRESSE

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums