[AC-2010] Choix d'une imprimante pour un état

[docjo]

Bonjour

Je tente d'imprimer un état en passant par un formulaire où j'affiche la fameuse table des imprimantes du code de la faq (Choisir une imprimante)
Ce code fonctionne puisqu'il me change bien l'imprimante par défaut mais si l'on veut à nouveau changer d'imprimante, il faut fermer le fichier access et le réouvrir.
N'y a-t-il pas moyen de changer d'imprimante sans fermer access ?

Code :

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
 
' J'ai modifié la fonction pour n'imprimer qu'un enregistrement précis
Function fMultiImpression(stNomFichier As String, stwhere as string)
 
' Impression d'états sur une ou plusieurs imprimantes
' Pré-requis : L'état doit être en imprimante par défaut
' Paramètre  : nom de l'état
 
On Error GoTo GestErr
 
If stNomFichier = "" Then Exit Function
 
Dim rs As Recordset
Dim dr As aht_tagDeviceRec
Dim stDvDefault As String   ' Unité de l'imprimante par défaut
Dim stDrDefault As String   ' Driver de l'imprimante par défaut
Dim stPrDefault As String   ' Port de l'imprimante par défaut
 
 
    'Stockage des paramètres de l'imprimante par défaut actuel
    If ahtGetDefaultPrinter(dr) Then
       stDvDefault = dr.drDeviceName
       stDrDefault = dr.drDriverName
       stPrDefault = dr.drPort
    End If
 
Set rs = CurrentDb().OpenRecordset("SELECT * FROM tbPrtList WHERE st_selection = true")
 
    If Not rs.EOF And Not rs.BOF Then
 
        While Not rs.EOF
            ' Chargement des paramètres de l'imprimante sélectionnée
            dr.drDeviceName = rs.Fields("[tx_PrtNom]")
            dr.drDriverName = rs.Fields("[tx_PrtDriver]")
            dr.drPort = rs.Fields("[tx_PrtPort]")
            ' L'imprimante devient imprimante par défaut
            ahtSetDefaultPrinter dr
'Quand on teste à ce niveau, il y a bien un changement d'imprimante mais il ne s'applique plus à l'état.
 
 
            ' Impression
            DoCmd.OpenReport stNomFichier, , acViewNormal, stWhere
 
            ' Fermeture fichier
            DoCmd.Close acReport, stNomFichier
 
            rs.MoveNext
        Wend
 
    End If
 
RestoreDftPrt:
 
    ' fermeture des objets
    rs.Close
     Set rs = Nothing
 
    ' Restauration de l'imprimante par défaut
    dr.drDeviceName = stDvDefault
    dr.drDriverName = stDrDefault
    dr.drPort = stPrDefault
    ahtSetDefaultPrinter dr
 
Exit Function
 
' Gestion des erreurs
GestErr:
 
    MsgBox "Erreur dans fMultiImpression : " & Error & " (" & Err & ")"
Resume RestoreDftPrt
 
End Function

Merci par avance

[ClaudeLELOUP]

Bonjour,

J'utilise ce code :

Code :

1
2
3
4
5
6
7
8
9
Public Sub Imprim()
Dim wsn As Object
Set wsn = CreateObject("WScript.Network")
wsn.SetDefaultPrinter "PDFCreator"
 DoCmd.OpenReport "état1"
wsn.SetDefaultPrinter "HP LaserJet 1018"
 DoCmd.OpenReport "état2", acViewPreview
Set wsn = Nothing
End Sub

[docjo]

Je cloture ce post par un commentaire: la solution du premier post change l'imprimante par défaut mais dans access garde toujours l'imprimante par défaut ouverte lors de la première ouverture. Par contre, si je ferme puis réouvre access, il accepte enfin de changer l'imprimante par défaut puis s'y bloque à nouveau (alors qu'en allant voir dans windows, l'imprimante par défaut change bien). Mystère !

J'ai adapté la solution de claudeLeloup, et là cela fonctionne. Voici mon code

API

Code :

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Const WM_WININICHANGE = &H1A
Private Const SMTO_NORMAL = &H0
Private Const HWND_BROADCAST = &HFFFF&Private Declare Function SendMessageTimeoutStr _
    Lib "user32" Alias "SendMessageTimeoutA" _
    (ByVal hwnd As Long, ByVal msg As Long, _
    ByVal wParam As Long, ByVal lParam As String, _
    ByVal fuFlags As Long, ByVal uTimeout As Long, _
    lpdwResult As Long) As LongPrivate Declare Function WriteProfileString _
    Lib "kernel32" Alias "WriteProfileStringA" _
    (ByVal lpszSection As String, ByVal lpszKeyName As String, _
    ByVal lpszString As String) As Long

Puis la fonction que j'ai adapté pour pouvoir imprimer l'état que je veux avec une ou plusieurs imprimantes

Code :

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
 
 
Public Function SetDefaultPrinter(stNomFichier As String, stWhere As String) As Boolean
Dim wsn As Object
    On Error GoTo Err_2
    Dim strBuffer As String
                '====================================
                ' Si DAO placer le 4 lignes suivantes
    Dim Rs As DAO.Recordset
    Set Rs = CurrentDb.OpenRecordset("SELECT LP_Names.* FROM LP_Names WHERE LP_Names.Lp_Default = true;")
On appelle un formulaire qui permet de cocher les imprimantes que l'on veut utiliser
                '====================================
                ' si Ado placer les 4 lignes suivantes
   ' Dim Rs As New ADODB.Recordset
   ' Rs.Open "SELECT LP_Names.* FROM LP_Names WHERE LP_Names.Lp_Name = '" _
   '      & Imprimante & "';", _
   '      CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
                '====================================
' On parcourt la table des imprimantes, puis on détermine l'imprimante par défaut
    If Not Rs.BOF Then
    While Not Rs.EOF
        strBuffer = Rs("Lp_Name") & "," & Rs("Lp_Driver") & "," & Rs("Lp_Port")
        Call WriteProfileString("Windows", "Device", strBuffer)
        Call SendMessageTimeoutStr(HWND_BROADCAST, WM_WININICHANGE, 0, "Windows", SMTO_NORMAL, 1000, 0)
        SetDefaultPrinter = True
                Set wsn = CreateObject("WScript.Network")
                    wsn.SetDefaultPrinter Rs("Lp_Name")
                        ' Impression de l'état
                        DoCmd.OpenReport stNomFichier, , , stWhere
                Set wsn = Nothing
    Rs.MoveNext
    Wend
    Else
        SetDefaultPrinter = False
    End If
Err_1:
    On Error Resume Next
        Rs.Close
    Set Rs = Nothing
    Exit Function
Err_2:
    SetDefaultPrinter = False
    Resume Err_1
End Function