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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
| Option Explicit
Dim import As Document
Dim Kanb As Document
Dim KanbM As Document
Dim res As Document
Dim aRange As Range
Dim aTable As Table
Dim bTable As Table
Dim cTable As Table
Dim lgkanb, col, cptkanb
Dim lgkanbm, colm, cpotkangm
Dim inter
Dim chemin
Dim Erro, ErrBT, ErrM, errp, errch
Dim Ctcout$
Dim Btgg$
Dim desi$
Dim num2$
Dim desiot$
Dim rechnom$
Dim PIcode$
Dim PTcode$
Dim PTdesi$
Dim EQcode$
Dim EQdesi$
Dim BTlocal$
Dim BTord$
Dim BTtype$
Dim BTperio$
Dim BTotp$
Dim BTtime$
Dim BTtitre$
Dim BTtitrecomplet$
Dim BTdate$
Dim BTnum$
Dim wordApp As Application
Dim otpTrouve As Boolean
Dim service As String
Dim Nomservice As String
Dim Codeservice As Long
Dim etapeservice As Long
Dim premeierecellule As String
Dim dernierecellule As String
Dim LastLig As Long
Dim trie As Long
Dim appXL As Object
Dim cheminxls As String
Dim Wb As Object
Dim impotp As String
Dim cheminpmp As String
Dim xlUp As Long
Dim i As Long, j As Long
Dim xlAscending As Long
Dim impkanb As String
Dim Impresum As String
Dim cheminkanb As String
Sub auto_Kanban()
If Codeservice = 2 Then
service = "PRODUCTION"
Nomservice = "FR03N1"
ElseIf Codeservice = 3 Then
service = "SGI"
Nomservice = "FR03SG"
Else
service = "MAINTENANCE"
Nomservice = "FR03MI"
Codeservice = 1
'Initialisation des erreurs :
Erro = 0
ErrBT = 0
ErrM = 0
trie = 0
End If
'********************************
chemin = ThisDocument.Path
Set import = Documents.Add
Set res = Documents.Add
res.Activate
res.ActiveWindow.View = wdNormalView
res.Content.Font.Size = 8
res.Content.Font.Name = "arial"
res.Content.InsertAfter "Résumé de l'édition des Kanbans du " & Date
res.Paragraphs.Add
res.Paragraphs(1).Alignment = wdAlignParagraphCenter
Set aRange = res.Paragraphs(1).Range
aRange.Font.Bold = True
aRange.Font.Size = 14
aRange.Borders.Enable = True
Btgen
End Sub
Sub Btgen()
import.Activate
import.ActiveWindow.View = wdNormalView
'Paramètrage de l'imprimante :
Set appXL = CreateObject("Excel.Application")
appXL.Visible = True
cheminxls = chemin + "\Listepmp2000.xls"
Set Wb = appXL.Workbooks.Open(cheminxls)
impotp = Wb.Sheets("Parametres").Range("ImprimanteOTP").Value
'Chemin des pmp
cheminpmp = Wb.Sheets("Parametres").Range("RepPMP").Value
'Chemin de l'extraction GMAO
cheminxls = Wb.Sheets("Parametres").Range("B10").Value
Wb.Close True 'fermeture du classeur
appXL.Quit
'Ouverture du fichier excel Extract SAP :
Set appXL = CreateObject("Excel.Application")
appXL.Visible = True
cheminxls = chemin + "\Extract SAP.xls"
Set Wb = appXL.Workbooks.Open(cheminxls)
With Wb.Worksheets("Extract SAP")
LastLig = .Range("F" & .Rows.Count).End(xlUp).Row
'Si le trie est déjà fait
If trie = 0 Then
For i = 6 To LastLig
'On inscrit dans la colonne "U" uniquement les 6 premiers caracteres de "T" en partant de la gauche
.Range("U" & i).Value = Left(.Range("T" & i).Value, 6)
'On inscrit dans la colonne "V" tous les caracteres de "G" sauf les 12 premiers caracteres de "G"
.Range("V" & i).Value = Mid(.Range("G" & i).Value, 13)
Next i
'On trie sur "U" et "V"
LastLig = .Cells(.Rows.Count, "F").End(xlUp).Row
.Range("B6:V" & LastLig).Sort Key1:=.Range("U6"), Order1:=xlAscending, Key2:=.Range("V6") _
, Order2:=xlAscending
trie = 1
End If
End With
'recherche la première cellule du nom service à traiter
i = 0
'compte le nombre de ligne du tableau pour le service en cours de traitement
For i = 6 To LastLig
If Wb.Sheets("Extract SAP").Range("T" & i).Value Like Nomservice & "*" Then
premeierecellule = i
Exit For
ElseIf Wb.Sheets("Extract SAP").Range("T" & i + 1).Value = "" And Codeservice = 3 Then
import.Close (False)
res.Close (False)
appXL.CutCopyMode = False
Wb.Close True
appXL.Quit
Codeservice = 1
If Erro <> 0 Or errp <> 0 Or errch <> 0 Then
MsgBox " Impression effectuée avec erreurs : " & vbNewLine & " Erreur d'ordre : " & Erro & vbNewLine & " Erreur de PMP (gamme) : " & errp & vbNewLine & " PMP non trouvé : " & errch
Else
MsgBox " Impression effectuée sans erreur"
End If
Exit Sub
ElseIf Wb.Sheets("Extract SAP").Range("T" & i + 1).Value = "" And Codeservice = 1 Then
import.Close (False)
res.Close (False)
appXL.CutCopyMode = False
Wb.Close True
appXL.Quit
Codeservice = 2
auto_Kanban
ElseIf Wb.Sheets("Extract SAP").Range("T" & i + 1).Value = "" And Codeservice = 2 Then
import.Close (False)
res.Close (False)
appXL.CutCopyMode = False
Wb.Close True
appXL.Quit
Codeservice = 3
auto_Kanban
End If
Next
i = premeierecellule
j = 0
'compte le nombre de ligne du tableau pour le service en cours de traitement
For j = 6 To LastLig
If Wb.Sheets("Extract SAP").Range("T" & j).Value Like Nomservice & "*" Then
Wb.Sheets("Extract SAP").Range("T" & j).Select
dernierecellule = Wb.Sheets("Extract SAP").Range("T" & j).Row
End If
Next
'copie le tableau, du service en cours de traitement, entier y compris les colonnes vides
Wb.Sheets("Extract SAP").Range("B" & premeierecellule & ":Q" & dernierecellule).Copy |
Problème variable xlUp, xlVisible
Répondre avec citation
Partager