Paramétrage imprimante

[patagaben]

Bonjour,

Je met en place un fichier de synthèse qui sera utilisé par différentes personnes sur différents postes.

Les configurations de ces postes sont relativement semblables (Ils ont tous PDFCreator)

Je voudrai créer un bouton d'impression sur PDF pour une feuille par exemple feuille 1, ce qui donne :

Sub editer()
Dim Variable_Imp As String
Variable_Imp = Application.ActivePrinter 'mise en memoire de l'imprimante par defaut
Application.ActivePrinter = "PDFCreator sur Ne??:" 'parametrer la nouvelle imprimante à utiliser pour créer le pdf
Sheets(Array("Feuille 1")).Select
ActiveSheet.PrintOut 'imprimer le pdf
Sheets("Accueil").Select
End Sub

MOn problème :
Les deux points d'interrogation... SUr certains postes il s'agit de 00, sur d'autres 01...

Est ce que quelqu'un pourtai m'expliquer comment faire pour que ma macro marche quel que soit le poste

D'avance merci à vous

 

[PMO2]

Re : Paramétrage imprimante

Bonjour,

Essayez avec le code suivant

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

Cordialement.

PMO
Patrick Morange

 

[jetted]

Re : Paramétrage imprimante

Chapeau Patrick Morange belle exemple de enum et de API.
tres apprecie

 

[PMO2]

Re : Paramétrage imprimante

Bonjour,

Merci Jetted pour tes appréciations.

Une autre approche, sans les APIs, qui utilise la gestion des erreurs et qui est peut-être plus simple à comprendre.

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

Cordialement.

PMO
Patrick Morange