1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
| Option Compare Database
Option Explicit
Private Declare Function GetProfileSection _
Lib "kernel32" Alias "GetProfileSectionA" _
(ByVal lpAppName As String, ByVal lpReturnedString As String, _
ByVal lngSize As Long) As Long
Private Const adhcMaxSection = 10000
Public strImprimanteDefautNom As String 'Nom de l'imprimante par défaut...
Function ListeImprimante() As String
' Retourne la liste des imprimantes
' dans la section [devices] de WIN.INI.
Dim strMatchstr As String
Dim strItems() As String
Dim strPrinters() As String
Dim strDetails() As String
Dim NomImprimante(20) As String
Dim PiloteImprimante(20) As String
Dim PortImprimante(20) As String
Dim liste As String
Dim strBuffer As String
Dim intCount As Integer
Dim i As Integer
On Error GoTo HandleErrors
'Lecture de Win.ini
strBuffer = Space(adhcMaxSection)
intCount = GetProfileSection("Devices", strBuffer, adhcMaxSection - 1)
strMatchstr = Left$(strBuffer, intCount)
If Len(strMatchstr) = 0 Then
intCount = 0
Else
strPrinters = Split(strMatchstr, vbNullChar)
ReDim aDevList(LBound(strPrinters) To UBound(strPrinters))
For i = LBound(strPrinters) To UBound(strPrinters)
If Len(strPrinters(i)) > 0 Then
strItems = Split(strPrinters(i), "=")
NomImprimante(i) = strItems(0)
strDetails = Split(strItems(1), ",")
PiloteImprimante(i) = strDetails(0)
PortImprimante(i) = strDetails(1)
liste = liste & NomImprimante(i) & ";" _
& PiloteImprimante(i) & ";" & PortImprimante(i) & ";"
End If
Next i
End If
ExitHere:
ListeImprimante = liste
Exit Function
HandleErrors:
Select Case err.Number
Case Else
err.Raise err.Number, err.Source, err.Description
End Select
End Function
Public Function ImprimanteParDefaut() As String
' Retourne la liste des imprimantes
' dans la section [devices] de WIN.INI.
Dim strMatchstr As String
Dim NomImprimante As String
Dim strBuffer As String
Dim intCount As Integer
Dim i As Integer
Dim PosDeb As Integer
Dim PosFin As Integer
Dim Longueur As Integer
On Error GoTo HandleErrors
ImprimanteParDefaut = ""
'Lecture de Win.ini de la section windows
strBuffer = Space(adhcMaxSection)
intCount = GetProfileSection("Windows", strBuffer, adhcMaxSection - 1)
strMatchstr = Left$(strBuffer, intCount)
If Len(strMatchstr) = 0 Then
intCount = 0
Else
PosDeb = InStr(1, strMatchstr, "Device=", vbTextCompare) + 7
PosFin = InStr(PosDeb, strMatchstr, ",", vbTextCompare)
Longueur = PosFin - PosDeb
ImprimanteParDefaut = Mid(strMatchstr, PosDeb, Longueur)
'Met l'imprimante par défaut comme imprimante courante
Set Printer = Printers(ImprimanteParDefaut)
End If
ExitHere:
Exit Function
HandleErrors:
Select Case err.Number
Case Else
err.Raise err.Number, err.Source, err.Description
End Select
End Function
Public Sub Select_Printer_PDF()
On Error GoTo Erreur_proPDF
'Nom de l'imprimante PDF...
'****************************************************'
'!!! Il faut entrer le bon nom de l'imprimante PDF!!!
'****************************************************'
Dim strImprimantePDFNom As String
strImprimantePDFNom = "CutePDF Writer" 'Ici le nom de l'imprimante PDF
'Sélection de CutePDF Writer comme imprimante par défaut...
Set Printer = Printers(strImprimantePDFNom)
Exit Sub
Sortie_proPDF:
Set Printer = Printers(strImprimanteDefautNom)
Exit Sub
Erreur_proPDF:
MsgBox err.Number & " : " & err.Description
err.Clear
Resume Sortie_proPDF
End Sub |
Partager