Etablir la liste des imprimantes [Résolu]

tyroute 3 Messages postés jeudi 24 juillet 2014Date d'inscription 24 juillet 2014 Dernière intervention - 24 juil. 2014 à 15:24 - Dernière réponse : jordane45 20629 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 26 avril 2018 Dernière intervention
- 24 juil. 2014 à 17:10
Bonjour,
Je suis sous excel VBA 6.3 et je cherche comment établir la liste des imprimantes installées sur un PC. Je veux imprimer une appli excel sur une imprimante définie (format de l'édition, etiquette autocollante).

Pouvez-vous m'aider ou m'indiquer ou je peux trouver le code?

Sur le forum, j'ai vu un code qui pourrait répondre à ma demande mais sur ma machine n'accepte pas certain code comme par exemple Dim imp as printer
printer n'est pas reconnu.

Merci de vos réponses.

Cordialement.

Thierry
Afficher la suite 

5 réponses

Répondre au sujet
jordane45 20629 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 26 avril 2018 Dernière intervention - 24 juil. 2014 à 15:24
0
Utile
Bonjour,
Je suis sous excel VBA
Dans ce cas;.. il faut poster dans la section VBA du forum...

Je déplace ton sujet au bon endroit.
Commenter la réponse de jordane45
tyroute 3 Messages postés jeudi 24 juillet 2014Date d'inscription 24 juillet 2014 Dernière intervention - 24 juil. 2014 à 15:27
0
Utile
merci jordane45
Commenter la réponse de tyroute
jordane45 20629 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 26 avril 2018 Dernière intervention - 24 juil. 2014 à 15:28
0
Utile
Sub printerlist()

    Dim owshNetwork As Object   'Network Port/Name Identifier collection
    Dim oPrinters As Object     'Printer Port/Name Identifier collection
    Dim i As Integer
    
    Set owshNetwork = CreateObject("WScript.Network")
    Set oPrinters = owshNetwork.EnumPrinterConnections
  
    Dim aryPrinters As Variant  'Array of Printer Names

    'Set the size of the Printer NAMES array
    ReDim aryPrinters(0 To oPrinters.Count \ 2 - 1)

    For i = 0 To UBound(aryPrinters)
        'Load this array element with the Name from the list
        aryPrinters(i) = oPrinters.Item(i * 2 + 1)
        Debug.Print oPrinters.Item(i * 2 + 1)
    Next i


End Sub


Commenter la réponse de jordane45
tyroute 3 Messages postés jeudi 24 juillet 2014Date d'inscription 24 juillet 2014 Dernière intervention - 24 juil. 2014 à 17:00
0
Utile
Re bonjour Jordan,

le code est parfait. Mais est-il possible d'afficher le nom complet avec le serveur d'impression.
Par exemple : la macro affiche ---> \\SERIMP03\SCPH0017
et je souhaiterais récupérer ceci --> \\SERIMP03\SCPH0017 sur Ne03:

D'avance merci.

Cordialement.

Thierry.
Commenter la réponse de tyroute
jordane45 20629 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 26 avril 2018 Dernière intervention - 24 juil. 2014 à 17:10
0
Utile
Oui

http://www.cpearson.com/excel/GetPrinters.aspx

Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modListPrinters
' By Chip Pearson, chip@cpearson.com  www.cpearson.com
' Created 22-Sept-2012
' This provides a function named GetPrinterFullNames that
' returns a String array, each element of which is the name
' of a printer installed on the machine.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234

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 Function RegEnumValue Lib "advapi32.dll" _
    Alias "RegEnumValueA" ( _
    ByVal HKey As Long, _
    ByVal dwIndex As Long, _
    ByVal lpValueName As String, _
    lpcbValueName As Long, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    lpData As Byte, _
    lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal HKey As Long) As Long

Public Function GetPrinterFullNames() As String()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetPrinterFullNames
' By Chip Pearson, chip@cpearson.com, www.cpearson.com
' Returns an array of printer names, where each printer name
' is the device name followed by the port name. The value can
' be used to assign a printer to the ActivePrinter property of
' the Application object. Note that setting the ActivePrinter
' changes the default printer for Excel but does not change
' the Windows default printer.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long    ' index into Printers()
Dim HKey As Long    ' registry key handle
Dim Res As Long     ' result of API calls
Dim Ndx As Long     ' index for RegEnumValue
Dim ValueName As String ' name of each value in the printer key
Dim ValueNameLen As Long    ' length of ValueName
Dim DataType As Long        ' registry value data type
Dim ValueValue() As Byte    ' byte array of registry value value
Dim ValueValueS As String   ' ValueValue converted to String
Dim CommaPos As Long        ' position of comma character in ValueValue
Dim ColonPos As Long        ' position of colon character in ValueValue
Dim M As Long               ' string index

' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"

PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 1000 characters
ReDim ValueValue(0 To 999)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)

' open the key whose values enumerate installed printers
Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
    KEY_QUERY_VALUE, HKey)
' start enumeration loop of printers
Res = RegEnumValue(HKey, Ndx, ValueName, _
    ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until Res = ERROR_NO_MORE_ITEMS
    M = InStr(1, ValueName, Chr(0))
    If M > 1 Then
        ' clean up the ValueName
        ValueName = Left(ValueName, M - 1)
    End If
    ' find position of a comma and colon in the port name
    CommaPos = InStr(1, ValueValue, ",")
    ColonPos = InStr(1, ValueValue, ":")
    ' ValueValue byte array to ValueValueS string
    On Error Resume Next
    ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
    On Error GoTo 0
    ' next slot in Printers
    PNdx = PNdx + 1
    Printers(PNdx) = ValueName & " on " & ValueValueS
    ' reset some variables
    ValueName = String(255, Chr(0))
    ValueNameLen = 255
    ReDim ValueValue(0 To 999)
    ValueValueS = vbNullString
    ' tell RegEnumValue to get the next registry value
    Ndx = Ndx + 1
    ' get the next printer
    Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _
        0&, DataType, ValueValue(0), 1000)
    ' test for error
    If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
        Exit Do
    End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
' Return the result array
GetPrinterFullNames = Printers
End Function

Commenter la réponse de jordane45

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.