Macro impression: gestion de "sur Ne00"

arnaudbu

XLDnaute Occasionnel
Bonjour le forum,

J'ai commencé à faire un bout de code pour laisser le choix d'imprimer en couleur ou pas.

Il y a environ 8 utilisateurs qui ont tous des imprimantes (réseaux) différentes d'installer, mais tous le monde à deux même imprimante d'installée (EPSON Color et EPSON Black).

Le soucis est que selon le poste, les imprimantes ne sont pas sur le même "Ne"...

Comment retrouver automatiquement le Ne associer à ces deux imprimantes, sinon avez vous une autre proposition.

@++
 

Pièces jointes

  • Nouveau Feuille de calcul Microsoft Excel.xls
    21.5 KB · Affichages: 42
  • Nouveau Feuille de calcul Microsoft Excel.xls
    21.5 KB · Affichages: 47
  • Nouveau Feuille de calcul Microsoft Excel.xls
    21.5 KB · Affichages: 45
Dernière édition:

kiki29

XLDnaute Barbatruc
Re : Macro impression: gestion de "sur Ne00"

Salut, peut-être via
Code:
Option Explicit

Private Declare Function EnumPrintersA Lib "Winspool.drv" _
                                       (ByVal flags As Long, ByVal Name As String, ByVal Level As Long, _
                                        pPrinterEnum As Long, ByVal cdBuf As Long, _
                                        pcbNeeded As Long, pcReturned As Long) As Long

Private Declare Function lstrlenA Lib "Kernel32" _
                                  (ByVal lpString As Any) As Long

Private Declare Function lstrcpyA Lib "Kernel32" _
                                  (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Sub RtlMoveMemory Lib "Kernel32" (pDest As Long, _
                                                  ByVal pSource As Long, ByVal Length As Long)

Private Function Imprimantes()
Dim PrinterEnum() As Long, Impr() As String
Dim Needed As Long, Returned As Long, I As Integer
    EnumPrintersA 2, vbNullString, 5, 0, 0, Needed, 0

    If Needed = 0 Then Exit Function
    ReDim PrinterEnum(Needed / 4)
    EnumPrintersA 2, vbNullString, 5, PrinterEnum(0), _
                  Needed, Needed, Returned
    ReDim Impr(1 To Returned)
    For I = 1 To Returned
        Impr(I) = Space$(lstrlenA(PrinterEnum(I * 5 - 5)))
        lstrcpyA Impr(I), PrinterEnum(I * 5 - 5)
    Next I
    Imprimantes = Impr
End Function

Sub ListeImprimante()
Dim Impr
    For Each Impr In Imprimantes
        Debug.Print Impr
    Next Impr
End Sub

Ici pour une imprimante Adobe PDF
Code:
Option Explicit

Dim sNomPortReseau As String

Private Function Imprimante_AdobePDF() As Boolean
Dim i As Long

    Imprimante_AdobePDF = False
    For i = 0 To 10
        If i < 10 Then
            sNomPortReseau = "Adobe PDF sur Ne0" & i & ":"
        Else
            sNomPortReseau = "Adobe PDF sur Ne" & i & ":"
        End If
        On Error Resume Next
        Application.ActivePrinter = sNomPortReseau
        If ActivePrinter = sNomPortReseau Then
            Imprimante_AdobePDF = True
            Exit For
        End If
    Next i
End Function

Sub Tst()
    If Imprimante_AdobePDF Then Debug.Print sNomPortReseau
End Sub
à adapter à ton contexte
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Macro impression: gestion de "sur Ne00"

Bonsoir arnaudbu, salut kiki29,

@kiki29 : ta fonction Private Function Imprimantes() paraît directement inspirée de cette procédure de Laurent Longre sur le site de Frédéric Sigonneau :

Ce site n'existe plus

Les variables sont identiques... Où as-tu donc trouvé ce code ?

Il est plus que souhaitable de citer ses sources, par respect pour les auteurs.

A+
 

arnaudbu

XLDnaute Occasionnel
Re : Macro impression: gestion de "sur Ne00"

Re,

J'ai trouvé un bout de code de PascalXLD que j'ai imbriqué dans ma base de départ. J'attends vos corrections et commentaires.

VB:
Option Explicit

Const ColorPrinter$ = "PDFCreator"
Const BlackPrinter$ = "PDFCreator"

Dim ChoixPrinter$, UsePrinter$

Dim MSG$

Dim i%
'-------------------------------------------------'

Sub imprime()

MSG = MsgBox("Voulez vous imprimer en couleur ?", vbYesNoCancel, "Impression du rapport")
    If MSG = vbYes Then
        ChoixPrinter = ColorPrinter
    Else
        ChoixPrinter = BlackPrinter
    End If
    
    If MSG = vbCancel Then Exit Sub
    
For i = 1 To 9
    UsePrinter = ChoixPrinter & " sur Ne0" & i & ":"
    On Error Resume Next
    
    Application.ActivePrinter = UsePrinter
      If ActivePrinter = UsePrinter Then Exit For
Next i

With Sheets("Rapport")
    .PageSetup.PrintArea = "$B$2:$N$32"
    .PrintOut Copies:=1, ActivePrinter:=ChoixPrinter, Collate:=True
End With

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 497
Messages
2 088 994
Membres
104 000
dernier inscrit
dinelcia