Paramétrage imprimante

Private Declare Function GetProfileSection& Lib "kernel32" Alias "GetProfileSectionA" ( _
  ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal lngSize As Long)

Sub editer()
Dim Variable_Imp As String
Dim VarTab As Variant
Dim i&
Variable_Imp = Application.ActivePrinter 'mise en memoire de l'imprimante par defaut

VarTab = EnumerePrinters
For i& = 1 To UBound(VarTab, 1)
  If VarTab(i&, 1) = "PDFCreator" Then
    Application.ActivePrinter = VarTab(i&, 1) & " sur " & VarTab(i&, 2)
    Exit For
  End If
Next i&

Sheets(1).PrintOut 'imprimer le pdf

Application.ActivePrinter = Variable_Imp
End Sub

Private Function EnumerePrinters() As Variant
Dim A$
Dim rep&
Dim cpt&
Dim pos&
Dim T()
A$ = Space(2048)
rep& = GetProfileSection("devices", A$, 2048)
If rep& > 0 Then
  A$ = Trim(Replace(A$, Chr(0), ""))
  Do Until A$ = ""
  cpt& = cpt& + 1
    ReDim Preserve T(1 To 2, 1 To cpt&)
    pos& = InStr(1, A$, "=") - 1
    T(1, cpt&) = Mid(A$, 1, pos&)
    pos& = InStr(1, A$, ",") + 1
    T(2, cpt&) = Mid(A$, pos&, InStr(1, A$, ":") + 1 - pos&)
    A$ = Mid(A$, InStr(1, A$, ":") + 1)
  Loop
End If
EnumerePrinters = Application.WorksheetFunction.Transpose(T)
End Function

Sub editerSansAPI()
Dim Variable_Imp As String
Dim VarTab As Variant
Dim A$
Dim cpt&
Variable_Imp = Application.ActivePrinter 'mise en memoire de l'imprimante par defaut

cpt& = 0
On Error Resume Next
Do
  Err = 0
  A$ = CStr(cpt&)
  If cpt& < 10 Then A$ = "0" & A$
  Application.ActivePrinter = "PDFCreator sur Ne" & A$ & ":"
  cpt& = cpt& + 1
  If cpt& > 99 Then Exit Do
Loop Until Err = 0
If cpt& > 99 Then Exit Sub
On Error GoTo 0


Sheets(1).PrintOut 'imprimer le pdf

Application.ActivePrinter = Variable_Imp
End Sub