Changement imprimante par défaut

Bonjour !

J'ai trouvé sur le net, une routine permettant de modifier l'imprimante par
défaut. L'objectif étant de générer un fichier pdf, puis rétablir
l'imprimante préalablement définie par défaut.

Cela fonctionne parfaitement sur un poste, mais l'imprimante par défaut
n'est pas modifiée sur certains autres postes !

Qu'est-ce qui peut influer sur le comportement de ce type de code ? dll ?
Mise à jour ? Autre chose ?

Vous en remerciant par avance !

Pour être complet, je recopie le code utilisé pour effectuer cette opération
:

J'ai copié le code suivant dans un module :
===================================
Option Compare Database 'Use database order for string comparisons
Option Explicit
Public ActualDefautPrinter As String
Public NewDefautPrinter As String
' Code from:
' Microsoft Access 95 How-To
' (c) 1998 Ken Getz and Paul Litwin
' All rights reserved.

' You may only use this code as part of an application
' that requires its use. You must including this
' notice intact. You may not distribute the code
' as your own work, nor can you distribute the
' code on its own.

Function ahtGetDefaultPrinter(dr As aht_tagDeviceRec) As Boolean

' Retrieve the default printer information. Though
' the function dutifully returns True if the
' values were available, and False otherwise, Windows
' really isn't happy without a default printer, and
' this situation rarely comes up.

' In:
' dr: a aht_tagDeviceRec structure to fill in
' Out:
' Return Value: True if info available, False otherwise.
' dr: filled in with default printer information,
' if it was available (check the function's return
' value).
'
' Comments:
' Requires the ahtGetToken() function from basGetToken
' Requires the ahtGetINIString() function from basINIFile
' Requires type definitions from basPrintTypes

Dim strBuffer As String

strBuffer = ahtGetINIString("Windows", "Device")
If Len(strBuffer) > 0 Then
With dr
.drDeviceName = ahtGetToken(strBuffer, ",", 1)
.drDriverName = ahtGetToken(strBuffer, ",", 2)
.drPort = ahtGetToken(strBuffer, ",", 3)
End With
ahtGetDefaultPrinter = True
Else
ahtGetDefaultPrinter = False
End If
ActualDefautPrinter = strBuffer
End Function

Function ahtSetDefaultPrinter(dr As aht_tagDeviceRec) As Boolean

' Set the default printer device in Win.INI

' In:
' dr: a aht_tagDeviceRec structure to use as
' the source of information.
' Out:
' Return Value: True if set correctly, False otherwise.
' If successful, writes a string in the form:
' device=HP LaserJet 4,HPPCL5E,LPT1:
' to your Win.INI file.
'
' Comments:
' Requires the aht_apiWriteProfileString() declaration from
basINIFile
' Requires type definitions from basPrintTypes

Dim strBuffer As String

' Build up the appropriate string.
strBuffer = dr.drDeviceName & ","
strBuffer = strBuffer & dr.drDriverName & ","
strBuffer = strBuffer & dr.drPort

' Now write that string out to WIN.INI.
ahtSetDefaultPrinter = (aht_apiWriteProfileString("Windows", _
"Device", strBuffer) <> 0)
End Function

Public Sub TestDefaultPrinter()

' Test the ahtDefaultPrinter() function.
' Fill in a DeviceRec structure with
' the pieces of the default printer info,
' and then print them out.

Dim dr As aht_tagDeviceRec

If ahtGetDefaultPrinter(dr) Then
Debug.Print "Device: "; dr.drDeviceName
Debug.Print "Driver: "; dr.drDriverName
Debug.Print "Port : "; dr.drPort
End If
End Sub
==================================

le code suivant dans un autre module :
===================================
Option Compare Database 'Use database order for string comparisons
Option Explicit

' Code from:
' Microsoft Access 95 How-To
' (c) 1998 Ken Getz and Paul Litwin
' All rights reserved.

' You may only use this code as part of an application
' that requires its use. You must including this
' notice intact. You may not distribute the code
' as your own work, nor can you distribute the
' code on its own.

Function ahtFillPrinterList(ctl As Control, varID As Variant, varRow As
Variant, varCol As Variant, varCode As Variant)

Static atagDevices() As aht_tagDeviceRec
Static intCount As Integer
Dim varRetval As Variant

Select Case varCode
Case acLBInitialize
intCount = ahtGetPrinterList(atagDevices())
varRetval = True

Case acLBOpen
varRetval = Timer

Case acLBGetRowCount
varRetval = intCount

Case acLBGetColumnCount
varRetval = 1

Case acLBGetValue
varRetval = atagDevices(varRow + 1).drDeviceName & " on " & _
atagDevices(varRow + 1).drPort

Case acLBEnd
Erase atagDevices
End Select
ahtFillPrinterList = varRetval
End Function

Function ahtGetPrinterList(atagDevices() As aht_tagDeviceRec) As Integer

' Fill an array of aht_tagDeviceRec structures with information
' about all the available, installed output devices.
'
' In:
' atagDevices(): an array of aht_tagDeviceRec
' structures to fill in.
' Out:
' Return Value: the number of items filled in
' atagDevices(): filled in with information about the devices.
'
' Comments:
' Requires type definitions from basPrintTypes
' Requires basINIFile for called functions
' Requires basGetToken for ahtGetTokens()

Dim astrPrinters() As String
Dim intCount As Integer
Dim varPrinters As Variant

' Get complete section labelled "[Devices]" from Win.INI
varPrinters = ahtGetProfileSection("DEVICES")

' If you got nothing back, then something's hideously wrong.
If Len(varPrinters & "") = 0 Then
ahtGetPrinterList = 0
Else
intCount = GetDevices(varPrinters, atagDevices())
End If
' intCount is either 0, from the call to GetProfileSection(), or
' it contains the number of different printers.
ahtGetPrinterList = intCount
End Function

Private Function GetDevices(ByVal strPrinters As String, atagDevices() As
aht_tagDeviceRec) As Integer

' At this point, strPrinters holds a list of
' printers pulled from Win.INI.

Dim intI As Integer
Dim strBuffer As String
Dim intCount As Integer

' Figure out how many printers there are in the list,
' and store that value in intCount.
For intI = 1 To Len(strPrinters)
If Mid$(strPrinters, intI, 1) = Chr$(0) Then
intCount = intCount + 1
End If
Next intI

ReDim atagDevices(1 To intCount)

For intI = 1 To intCount
' Split up the entries which look like this:
' Device=Driver,Port
strBuffer = ahtGetToken(strPrinters, Chr$(0), intI)
' Get the part before the "="
atagDevices(intI).drDeviceName = ahtGetToken(strBuffer, "=", 1)
' Get all the stuff after the "="
strBuffer = ahtGetToken(strBuffer, "=", 2)

' Now pull out the two pieces.
atagDevices(intI).drDriverName = ahtGetToken(strBuffer, ",", 1)
atagDevices(intI).drPort = ahtGetToken(strBuffer, ",", 2)
Next intI
GetDevices = intCount
End Function
============================================

Le code suivant dans un 3ème module
============================================
Option Compare Database 'Use database order for string comparisons
Option Explicit

' Code from:
' Microsoft Access 95 How-To
' (c) 1998 Ken Getz and Paul Litwin
' All rights reserved.

' You may only use this code as part of an application
' that requires its use. You must including this
' notice intact. You may not distribute the code
' as your own work, nor can you distribute the
' code on its own.

' Structure for device information
' This structure, unlike the aht_tagDEVMODE
' and aht_tagDEVNAMES, doesn't have a counterpart
' in the Windows SDK. It's just a convenience
' for Access programmers.
Type aht_tagDeviceRec
drDeviceName As String
drDriverName As String
drPort As String
End Type

' Structure to hold DEVMODE information.
Type aht_tagDEVMODE
dmDeviceName(1 To 32) As Byte
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName(1 To 32) As Byte
dmLogPixels As Integer
dmBitsPerPixel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long
dmICMIntent As Long
dmMediaType As Long
dmDitherType As Long
dmICCManufacturer As Long
dmICCModel As Long
dmDriverExtraBytes(1 To 1024) As Byte

End Type

' You'll need a user-defined type in order
' to use LSet to copy the values from a DEVMODE
' structure into a string, and vice-versa.
Type aht_tagDEVMODEStr
DMStr As String * 1024
End Type

' Structure to hold DEVNAME information
Type aht_tagDEVNAMES
dnDriverOffset As Integer
dnDeviceOffset As Integer
dnOutputOffset As Integer
dnDefault As Integer
End Type

' You 'll need a user-defined type in order
' to use LSet to copy the values from a DEVNAMES
' structure into a string, and vice-versa.
Type aht_tagDEVNAMEStr
DNStr As String * 4
End Type

' Structure to hold prtMIP information.
Type aht_tagMIP
xLeftMargin As Long
yTopMargin As Long
xRightMargin As Long
yBotMargin As Long
fDataOnly As Long
xFormSize As Long
yFormSize As Long
fDefaultSize As Long
cxColumns As Long
xFormSpacing As Long
yFormSpacing As Long
radItemOrder As Long
fFastPrinting As Long
fDataSheet As Long
End Type

Type aht_tagMIPSTR
MIPStr As String * 28
End Type
===================================

Le code suivant dans un 4ème module
============================================
Option Compare Database 'Use database order for string comparisons
Option Explicit

' Code from:
' Microsoft Access 95 How-To
' (c) 1998 Ken Getz and Paul Litwin
' All rights reserved.

' You may only use this code as part of an application
' that requires its use. You must including this
' notice intact. You may not distribute the code
' as your own work, nor can you distribute the
' code on its own.

Function ahtGetToken(ByVal strValue As String, ByVal strDelimiter As String,
ByVal intPiece As Integer) As Variant

Dim intPos As Integer
Dim intLastPos As Integer
Dim intNewPos As Integer

On Error GoTo ahtGetTokenExit

' Make sure the delimiter is just one character.
strDelimiter = Left(strDelimiter, 1)

' If the delimiter doesn't occur at all, or if
' the user's asked for a negative item, just return the item
' they passed in.

If (InStr(strValue, strDelimiter) = 0) Or (intPiece <= 0) Then
ahtGetToken = strValue
Else
intPos = 0
intLastPos = 0
Do While intPiece > 0
intLastPos = intPos
intNewPos = InStr(intPos + 1, strValue, strDelimiter)
If intNewPos > 0 Then
intPos = intNewPos
intPiece = intPiece - 1
Else
' Catch the last piece, where there's no
' trailing token.
intPos = Len(strValue) + 1
Exit Do
End If
Loop
If intPiece > 1 Then
ahtGetToken = Null
Else
ahtGetToken = Mid$(strValue, intLastPos + 1, intPos - intLastPos -
1)
End If
End If

ahtGetTokenExit:
Exit Function

ahtGetTokenErr:
MsgBox "Error in ahtGetToken: " & Error & " (" & Err & ")"
Resume ahtGetTokenExit
End Function

===================================================
--
Bien cordialement,

Joël GARBE
www.joelgarbe.fr