Bonjour,

J'ai concu, à l'aide de ce site et des differents forum, post etc..., un petit code VBA qui me permet d'automatiser beaucoup de tâches.

Dans les grandes lignes, PUBLIPOSTAGE d'Excel vers Word sur des Signets

Malheureusement, je suis bloqué depuis un certain moment sur un gros problème que je n'arrive pas à résoudre á l'aide des FAQ, Forum, TUTO et autres.

Je n'arrive pas à changer l'imprimante par défaut.
Je ne peux pas mettre d'imprimante fix, car l'appli sera sur plusieurs postes.
J'ai beau essayé de définir l'imprimante, mais rien, il reste bloqué sur l'imprimante par défaut

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
Application.Dialogs(Excel.XlBuiltInDialog.xlDialogPrinterSetup).Show
drucker = Application.ActivePrinter
 
...... Bookmarks "partie du code" etc
 
ActivePrinter = drucker
        Debug.Print ActivePrinter
        oDoc.PrintOut Copies:=koPie
Debug.Print me revoit l'imprimante souhaité, mais reste bloqué sur l'imprimante par défaut
Je ne souhaite pas FIGER l'imprimante, en mettant "imprimante tel ou telle" car elle ne sera pas identique à tous les User

Comment faire ? J'ai lu des trucs à gauche et droite au sujet d'API etc... mais là je sèche

Merci pour votre aide

Le code au complet
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Option Explicit
 
Public Sub SDlos_Click()
 
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlSh As Excel.Worksheet
Dim iR As Integer
Dim i As Integer, j As Integer
Dim wdApp           As Word.Application
Dim oDoc            As Word.Document
Dim koPie           As Integer
Dim drucker         As String
 
Application.Dialogs(Excel.XlBuiltInDialog.xlDialogPrinterSetup).Show
drucker = Application.ActivePrinter
 
'Affectation des données aux variables
Set xlApp = Excel.Application
Set xlWb = xlApp.ThisWorkbook '("TestPlz.xlsm")
Set xlSh = xlWb.Worksheets("Pzt_Liste")
 
 
koPie = InputBox("Anzahl von Kopie", "Drucker")
If koPie < 1 Then Exit Sub
 
Set wdApp = New Word.Application
wdApp.Visible = True
xlSh.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
 
'Récupération du nombre de lignes et de colonnes
iR = xlSh.UsedRange.Rows.Count
 
' Récupération des données de la feuille pour les injecter dans le document.
For i = 4 To iR
 
 Set oDoc = Documents.Open("M:\Palettenfahnen\pzt_VPM_leer.docx") ' le doc de fusion
 
        oDoc.Bookmarks("Palnr").Range.Text = xlSh.Cells(i, 1)
        oDoc.Bookmarks("PalnrA").Range.Text = xlSh.Cells(i, 1)
        oDoc.Bookmarks("ExPal").Range = Format(xlSh.Cells(i, 2), "###,###")
        oDoc.Bookmarks("ExPalA").Range = Format(xlSh.Cells(i, 2), "###,###")
        oDoc.Bookmarks("ExVb").Range.Text = xlSh.Cells(i, 3)
        oDoc.Bookmarks("PakLage").Range.Text = xlSh.Cells(i, 4)
        oDoc.Bookmarks("LagPal").Range.Text = xlSh.Cells(i, 6)
        oDoc.Bookmarks("volleLag").Range.Text = xlSh.Cells(i, 6)
        oDoc.Bookmarks("Pakete").Range.Text = xlSh.Cells(i, 7)
        oDoc.Bookmarks("Matchcode").Range.Text = xlSh.Cells(i, 10)
        oDoc.Bookmarks("MatchcodeA").Range.Text = xlSh.Cells(i, 10)
        oDoc.Bookmarks("Objekt").Range.Text = xlSh.Cells(i, 11)
        oDoc.Bookmarks("ObjektA").Range.Text = xlSh.Cells(i, 11)
        oDoc.Bookmarks("Split").Range.Text = xlSh.Cells(i, 12)
        oDoc.Bookmarks("SplitA").Range.Text = xlSh.Cells(i, 12)
        oDoc.Bookmarks("Auflage").Range = Format(xlSh.Cells(i, 13), "###,###")
        oDoc.Bookmarks("Lieferad").Range.Text = xlSh.Cells(i, 14)
        oDoc.Bookmarks("Strasse").Range.Text = xlSh.Cells(i, 15)
        oDoc.Bookmarks("Ort").Range.Text = xlSh.Cells(i, 16)
        oDoc.Bookmarks("anzahlPal").Range.Text = xlSh.Cells(i, 17)
        oDoc.Bookmarks("anzahlPalA").Range.Text = xlSh.Cells(i, 17)
 
        ActivePrinter = drucker
        Debug.Print ActivePrinter
        oDoc.PrintOut Copies:=koPie
        oDoc.SaveAs "M:\Palettenfahnen\Erzeugte_pzt\" & xlSh.Cells(i, 11) & "_" & Format(Date, "yyyy-mm-dd") & "_" & xlSh.Cells(i, 1) & " .docx"
        oDoc.Close SaveChanges:=wdDoNotSaveChanges
 
Next i
 
xlSh.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
'--------------------
'Sauvegarde Pzt_Liste
'--------------------
xlWb.SaveCopyAs "M:\Palettenfahnen\Erzeugte_pzt\" & xlSh.Cells(4, 11) & "_" & Format(Date, "yyyy-mm-dd") & "_" & xlSh.Cells(4, 17) & " .xlsm"
 
wdApp.Quit
 
Set oDoc = Nothing
Set wdApp = Nothing
Set xlSh = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
 
End Sub