Discussion :

[graphikris]

Bonjour,

Grace à l'aide de Kiki29 du forum, j'ai pu créer une macro me permettant d'extraire des renseignements d'une feuille vers un nouveau classeur puis de mettre en forme la nouvelle feuille pour ensuite l'exporter au format Pdf pour une publication sur le site Intranet de ma société.
Cette publication est effective lorsque le fichier Pdf est exporté vers notre serveur. Mais le souci est que ce serveur est bien souvent occupé.

Je voudrais donc savoir si quelqu'un aurait en boutique un bout de code me permettant de ne plus avoir en cas d'occupation du serveur, la phrase habituelle de Microsoft Visual Basic (voir copie écran si dessous) mais plutôt un message Box me disant : "Serveur occupé, veuillez réitérer votre macro ultérieurement."

Pièce jointe 205072

Voici le bout de mon code pour la publication :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
'Publication du fichier en Pdf
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:="U:\Groupes fonctionnels\Extraction referentiel documentaire.pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
 
    'Fermeture du nouveau classeur
    ActiveWorkbook.Close False
 
  'Message de publication du document
  rep = MsgBox("Votre extraction a été publiée avec succès. Vous pouvez la consulter directement sur le portail intranet.", vbYes + vbInformation, "Publication de document...")

Merci pour votre aide.

[cerede2000]

Qu'entends tu pas serveur occupé ?
Il s'agit d'un serveur de fichiers non ?

Tu viens remplacer un fichier existant qui peut déjà être ouvert par quelqu'un ?

[graphikris]

Il s'agit d'un serveur de fichiers non ?

Oui tout à fait.

Tu viens remplacer un fichier existant qui peut déjà être ouvert par quelqu'un ?

Effectivement, ce fichier étant sur le serveur "U" de ma société, il se peut que quelqu'un ou même plusieurs personnes consultent le Pdf pendant sa publication.

[cerede2000]

Ok !
Essaye ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
 
Function FileLocked(strFileName As String) As Boolean
   On Error Resume Next
   Open strFileName For Binary Access Read Write Lock Read Write As #1
   Close #1
   If Err.Number <> 0 Then
      MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
      FileLocked = True
      Err.Clear
   End If
End Function

Ca permet de tester si le fichier est locké ou pas

[graphikris]

Merci mais je le place où ce code ?
A la ligne 11 de mon extrait de code ou autre part ?
Mais juste une question car je ne serais pas la seule a utiliser la macro.
Où puis je mettre par rapport a ton code, un msg box du style : "Serveur occupé, veuillez réitérer votre macro ultérieurement."

Je te remercie pour ton aide

[cerede2000]

Ce code tu le met dans un module, c'est une fonction que tu va appeler dans ton code existant.
Il faut le faire avant d'exporter en PDF afin d'être sur que ça va fonctionner

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
...
If FileLocked("U:\Groupes fonctionnels\Extraction referentiel documentaire.pdf") Then
    MsgBox "Veuillez ressayer plus tard...."
Else
    'Tu exporte en PDF
End If

[graphikris]

Bon Ok, je résume pour voir si j'ai tout compris.
Je crée un nouveau module qui j'intitule par exemple "Test_Serveur_U"
J'y insére ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
 
Function FileLocked(strFileName As String) As Boolean
   On Error Resume Next
   Open strFileName For Binary Access Read Write Lock Read Write As #1
   Close #1
   If Err.Number <> 0 Then
      MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
      FileLocked = True
      Err.Clear
   End If
End Function

Puis dans ma macro (module intitulé : Excel2Pdf2U), je met ceci avant la publication :

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
 'Test si le fichier Pdf existant sur le serveur est utilisé par quelqu'un
 If FileLocked("U:\Groupes fonctionnels\Extraction referentiel documentaire.pdf") Then
    MsgBox "Veuillez ressayer plus tard...."
Else
   'Publication du fichier en Pdf
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:="U:\Groupes fonctionnels\\Extraction referentiel documentaire.pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
 
End If
 
    'Fermeture du nouveau classeur
    ActiveWorkbook.Close False
 
  'Message de publication du document
  rep = MsgBox("Votre extraction a été publiée avec succès. Vous pouvez la consulter directement sur le portail Intranet.", vbYes + vbInformation, "Publication de document...")

J'ai du mal a comprendre comment va se déclencher le 1er code puisque ma macro de publication est commandée par un bouton qui la déclenche elle mais pas le 1er code.

[cerede2000]

Eu..... Comment dire.....
Tu est familier avec le concept de fonction ??

Ton clic sur le bouton déclenche par événement la fonction qui lui est associé Sub monboutton_Click()....
Mais cette fonction peux elle même appeler d'autres fonctions
De la même manière que tu le fais déjà avec par exemple ActiveSheet.ExportAsFixedFormat qui est une fonction (méthode de la classe Worksheet).

Donc la on créé une fonction nous même appelée FileLocked et on l'appelle

Tu n'est pas obligé de la mettre dans un autre module, tu peux la placer dans ton module existant.
Attention le Option Explicit doit être tout en haut en 1ere ligne dans ton module.

[graphikris]

D'accord je comprend mieux.

Voici donc le code dans sa globalité :

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
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
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
Option Explicit
 
Function FileLocked(strFileName As String) As Boolean
   On Error Resume Next
   Open strFileName For Binary Access Read Write Lock Read Write As #1
   Close #1
   If Err.Number <> 0 Then
      MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
      FileLocked = True
      Err.Clear
   End If
End Function
 
Sub Recherche_Doc_Intranet()
 
'rep = MsgBox("Extraction de la liste des documents du référentiel pour mise en ligne sur le portail Intranet.", vbYes + vbInformation, "Extraction automatique...      Application développée par G.")
 
Select Case MsgBox("Désirez-vous extraire puis publier, sur le portail Intranet, la liste des documents du référentiel  ?", vbYesNo, "Application développée par G.")
   Case vbYes
        'procédure si click sur Oui
 
    Dim nom As String
    Dim Wbk As Workbook
    Set Wbk = Workbooks.Add
 
Windows("Base de données.xlsm").Activate
Sheets("Suivi Referentiel documentaire").Select
    ActiveSheet.Unprotect
    ActiveSheet.Range("$A$1:$K$600").AutoFilter Field:=5, Criteria1:="<>"
    Columns("A:F").Select
    Selection.Copy
    Wbk.Activate
    ActiveSheet.Paste
    Columns("A:F").EntireColumn.AutoFit
    ActiveWindow.ScrollRow = 1
    Rows("2:513").EntireRow.AutoFit
    Range("A1").Select
    Windows("Base de données.xlsm").Activate
    ActiveSheet.Range("$A$1:$K$600").AutoFilter Field:=5
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
    Sheets("Requetes").Select
    Wbk.Activate
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.RowHeight = 45
    Range("A1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:F1").Select
    ActiveCell.FormulaR1C1 = "Liste du référentiel documentaire"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Extraction du"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
 
        'Mise en page nouvelle feuille Excel
    Rows("4:4").RowHeight = 30.75
    Rows("4:4").Select
    Selection.Font.Size = 8
    Columns("A:A").ColumnWidth = 6.86
    Columns("A:A").Select
    Range("A2").Activate
    Selection.ColumnWidth = 7.29
    Columns("B:B").Select
    Range("B2").Activate
    Selection.ColumnWidth = 8.43
    Range("B4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("5:600").Select
    Range("A600").Activate
    Selection.Font.Size = 8
    ActiveWindow.ScrollRow = 1
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Range("A2").Select
    Selection.Font.Size = 8
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B2:C2").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("E5:E600").Select
    Range("E600").Activate
    Rows("5:600").EntireRow.AutoFit
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.ScrollRow = 1
    ActiveWindow.SmallScroll Down:=60
    Columns("E:E").ColumnWidth = 66.7
 
Columns("E:E").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
 
Range("A1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Calibri"
        .Size = 22
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleDouble
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
 
    Range("A2").Select
    With Selection.Font
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = -0.249977111117893
    End With
    Range("B2:C2").Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
 
    Range("F4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
    Range("A5:F600").Select
    Range("F600").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveWindow.ScrollRow = 1
 
        Range("B2:C2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Selection.Font.Size = 10
    Selection.Font.Size = 9
    Range("C2:F2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("C2:F2").Select
    ActiveCell.FormulaR1C1 = _
        "Faites "" CRTL + F "" pour procéder à une recherche. Pensez à respecter la casse (Espace, tirets, etc…)"
    Range("C2:F2").Select
    With Selection.Font
        .Color = -6279056
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Font.Size = 12
    Range("F4").Select
 
    'mise en page A3 et pied de page
 
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "Page &P sur &N"
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
 
 'Test si le fichier Pdf existant sur le serveur est utilisé par quelqu'un
 If FileLocked("U:\Groupes fonctionnels\Extraction referentiel documentaire.pdf") Then
    MsgBox "Veuillez ressayer plus tard...."
Else
   'Publication du fichier en Pdf
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:="U:\Groupes fonctionnels\Extraction referentiel documentaire.pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
 
End If
 
    'Fermeture du nouveau classeur
    ActiveWorkbook.Close False
 
  'Message de publication du document
  'rep = MsgBox("Votre extraction a été publiée avec succès. Vous pouvez la consulter directement sur le portail Intranet.", vbYes + vbInformation, "Publication de document...")
 
    'procédure si click sur Non
   Case vbNo
   'rep = MsgBox("Abandon de votre extraction. Vous pouvez toujours consulter l'ancienne directement sur le portail Intranet.", vbYes + vbInformation, "Abandon de publication de document...")
End Select
End Sub

Est-ce correct ?
Sinon petit hic, avant les :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 rep = MsgBox("Abandon de votre extraction. Vous pouvez toujours consulter l'ancienne directement sur le portail Intranet.", vbYes + vbInformation, "Abandon de publication de document...")

fonctionnaient sans Pb, maintenant Excel me dit qu'il y a un pb. J'ai donc mis des cotes devant.
Comment faire pour que mes msg apparaissent.

MErci

[cerede2000]

Survolé rapidement car ça fait une belle tartine, mais oui ça me parait ok.

Par contre pour ton MsgBox, je ne vois pas ce qui pourrait faire que ça ne fonctionne pas.
Pour info, le rep = MsgBox n'as pas d’intérêt si tu n'attends pas une réponse de la part de l'utilisateur via le MsgBox.

Edit !!! Ah mais si hihihihi
Tu as maintenant un Option Explicit en haut de ton module et donc toutes les variables que tu utilisent doivent être déclaré
Donc Dim mavar (le mieux avec un type ! ) Dim mavar as string...
Donc comme ta var rep que tu utilise avec tes MsgBox ne sont pas déclarés...

[graphikris]

Bjr et merci pour tes explications qui me permettent de m'améliorer dans la compréhension du VBA.

Dernier petit souci mais ici ça relève de mon cerveau mal connecté.

Dans la fin du code, si le serveur n'est pas occupé, la publication sur le serveur s'effectue puis j'ai un message qui m'informe que tout s'est bien déroulé sinon dans le cas contraire, j'ai un message qui m'informe que le serveur est occupé puis je DEVRAIS avoir un autre message m'informant que l'opération est abandonnée.

Je dis bien je DEVRAIS car ici j'ai le message qui me dit que la publication s'est bien effectuée. Je suppose que c'est juste une position du code (VbYes et VbNO).

Voici le code en version allégé pour une meilleur compréhension :

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
Sub Recherche_Doc_Intranet()
 
' On déclare rep des MsgBox comme une chaîne car il y a Explicit Option en haut
Dim rep As String
 
rep = MsgBox("Extraction de la liste des documents du référentiel pour mise en ligne sur le portail Intranet.", vbYes + vbInformation, "Extraction automatique...      Application développée par G.")
 
Select Case MsgBox("Désirez-vous extraire puis publier, sur le portail Intranet, la liste des documents du référentiel  ?", vbYesNo, "Application développée par G.")
   Case vbYes
        'procédure si click sur Oui
 
    Dim nom As String
    Dim Wbk As Workbook
    Set Wbk = Workbooks.Add
 
...................' ici le reste du code sans intérêt pour ma question
...................' puis on reprend ici la suite du code
 
'Test si le fichier Pdf existant sur le serveur est utilisé par quelqu'un
    If FileLocked("U:\Groupes fonctionnels\Extraction referentiel documentaire.pdf") Then
        rep = MsgBox("Une personne consulte l'ancienne extraction sur le serveur. Vous ne pouvez donc pas publier la nouvelle. Veuillez réessayer ultérieurement.", vbYes + vbInformation, "Serveur occupé...")
 
Else
'Publication du fichier en Pdf
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:="U:\Groupes fonctionnels\Extraction referentiel documentaire.pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
 
End If
 
'Fermeture du nouveau classeur
    ActiveWorkbook.Close False
 
'Message de publication du document
  rep = MsgBox("Votre extraction a été publiée avec succès. Vous pouvez la consulter directement sur le portail Intranet.", vbYes + vbInformation, "Publication de document...")
 
'procédure si click sur Non
   Case vbNo
   rep = MsgBox("Abandon de votre extraction. Vous pouvez toujours consulter l'ancienne directement sur le portail Intranet.", vbYes + vbInformation, "Abandon de publication de document...")
End Select
End Sub

Merci

[cerede2000]

Rien à voir avec vbYes et vbNo...

Tel que c'est codé la ton MsgBox apparaîtra tout le temps !

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
Sub Recherche_Doc_Intranet()
 
' On déclare rep des MsgBox comme une chaîne car il y a Explicit Option en haut
Dim rep As String
 
rep = MsgBox("Extraction de la liste des documents du référentiel pour mise en ligne sur le portail Intranet.", vbYes + vbInformation, "Extraction automatique...      Application développée par G.")
 
Select Case MsgBox("Désirez-vous extraire puis publier, sur le portail Intranet, la liste des documents du référentiel  ?", vbYesNo, "Application développée par G.")
   Case vbYes
        'procédure si click sur Oui
 
    Dim nom As String
    Dim Wbk As Workbook
    Set Wbk = Workbooks.Add
 
...................' ici le reste du code sans intérêt pour ma question
...................' puis on reprend ici la suite du code
 
'Test si le fichier Pdf existant sur le serveur est utilisé par quelqu'un
    If FileLocked("U:\Groupes fonctionnels\Extraction referentiel documentaire.pdf") Then
        MsgBox("Une personne consulte l'ancienne extraction sur le serveur. Vous ne pouvez donc pas publier la nouvelle. Veuillez réessayer ultérieurement.", vbInformation, "Serveur occupé...")
    Else
'Publication du fichier en Pdf
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                        Filename:="U:\Groupes fonctionnels\Extraction referentiel documentaire.pdf", _
                                        Quality:=xlQualityStandard, _
                                        IncludeDocProperties:=True, _
                                        IgnorePrintAreas:=False, _
                                        OpenAfterPublish:=False
      MsgBox("Votre extraction a été publiée avec succès. Vous pouvez la consulter directement sur le portail Intranet.", vbYes + vbInformation, "Publication de document...")
      'Fermeture du nouveau classeur
      ActiveWorkbook.Close False
    End If
    Case vbNo
      MsgBox("Abandon de votre extraction. Vous pouvez toujours consulter l'ancienne directement sur le portail Intranet.", vbInformation, "Abandon de publication de document...")
End Select
End Sub

[graphikris]

Ah oui c'est mieux.
C'est comme quand on se relie, on ne voit pas les fautes et lorsqu'une collégue vous montre vos fautes alors là on dit : Mais bien sûr je le savais.

Encore Merci

Post Clos