Aperçu et Impression en VBA

Version imprimable

24/09/2019, 14h50
RJSCVF

1 pièce(s) jointe(s)

Aperçu et Impression en VBA

J'ai récemment ouvert une discussion sur l'interdiction d'insérer et de supprimer des lignes sur une plage de donnée par code VBA.
J'ai été très satisfait par la réponse de lionel.
Je suis aussi d'accords avec la réponse de Pierre que nous devons échanger sur l'espace public ou tout le monde peut participer et apprendre. D'ailleurs moi-même je veux apprendre, je suis novice en VBA et je fais mes premiers pas aux forums.
Merci beaucoup à Pierre et à Lionel.

Cela dit, si vous voulez toujours bien m'aider, j'ai une autre préoccupation sur ce même fichier.

Lorsque je clique sur le bouton "Imprimer et Archiver", l'aperçu s'affiche. Mais voici le problème :

1) Si je clique sur "fermer l'aperçu", qui se ferme, la boîte de dialogue de choix des imprimantes s'affiche normalement. Mais si je clique sur le "bouton annuler" de cette boîte, l'impression et bien annulée, mais cependant, l'archive se crée. Mais je voudrais que l'archive se crée seulement si on lance l'impression. Pas si on annule l'impression.

2) Dans l'aperçu, si je clique sur le bouton "imprimer", l'impression se lance directement sur l'imprimante par défaut, puis la boîte de dialogue de choix des imprimantes s'affiche quand même, alors qu'une impression est déjà passée. Serait-il possible que si dans l'aperçu je clique sur le bouton "imprimer" que la boîte de dialogue de choix des imprimantes s'affiche d'abord pour que je fasse le choix, mais que l'impression par défaut ne se lance pas ? Voici le lien du fichier : Pièce jointe 505293

Je sais que c'est trop demander. Ne soyez pas obligé ! Cependant, votre aide sera la bienvenue.

Merci à tous !
24/09/2019, 14h54
Pierre Fauconnier

Salut.

Il faudrait donner le code vba que tu utilises pour que l'on puisse t'aider (en l'entourant des balises de code => sélection du code puis clic sur le bouton # dans la barre d'outils du message).
24/09/2019, 15h14
RJSCVF

Salut, merci pour la réponse !

Voici le fichier en question avec les codes.
Ce sont des codes que j'ai pris sur internet.
~~Voici le lien du fichier :~~
Le mot de passe est : 1
Amicalement
RJSCVF
24/09/2019, 15h27
Pierre Fauconnier

Il est préférable de poster le code qui pose problème que le fichier lui-même. L'idée n'est pas d'avoir une solution toute faite, mais de pouvoir appliquer par toi-même les solutions qui seront proposées. Il est donc plus utile de poster le code et non de joindre le fichier ;)
24/09/2019, 15h40
RJSCVF

OK, merci pour la remarque.

Prochainement, je ferai selon votre conseil.
Merci
RJSCVF

Bonjour,

Peux etre avec ça

Code:

1
2
3
4
5
 
 
If Application.Dialogs(xlDialogPrinterSetup).Show = False Then
    Exit Sub
End If

Cordialement,

Salut.

Perso, je préfère éviter Exit Sub ;)

Code:

1
2
3
If Not Application.Dialogs(xlDialogPrinterSetup).Show = False Then
  ... ' suite du traitement
End If

24/09/2019, 17h21
RJSCVF

Salut et merci pour le réponses
Voici le code que je viens d'adapter suivant vos posts :

Pour le 1er code :
Code:

1 2 3 4 5 ActiveSheet.Unprotect "1" Worksheets("Marchandises").PrintOut , Preview:=True If Application.Dialogs(xlDialogPrinterSetup).Show = False Then Exit Sub End If
Avec le prermier code, lorque j'annule l'impression avec la boîte de dialogue choix de l'imprimante, l'impression est annulée et l'archive ne se crée pas. Ce qui est déjà une partie de la réponse à ce que j'ai voulais faire.

Mais lorsque au lieu d'annuler l'impression, je clique sur le bouton imprimer de cette même boîte de choix de l'imprimante, l'impression ne se lance pas, bien que l'archive se crée. Mais il faut que l'impression se lance d'abord puis que l'archive se crée.

Quant au 2ème code :
Code:

1 2 3 4 ActiveSheet.Unprotect "1" Worksheets("Marchandises").PrintOut , Preview:=True If Not Application.Dialogs(xlDialogPrinterSetup).Show = False Then End If
Tout marche comme avant, comme si le code n'avait pas été modifié. C'est-à-dire que rien n'a changer !

Amicalement

RJSCVF
24/09/2019, 17h25
Pierre Fauconnier

Tu ne postes pas assez de code pour que l'on puisse voir où ça cloche.

Les deux solutions proposées supposent que l'archive se crée APRES la demande d'impression, avortée ou non. Si tu choisis la mienne, ce que je te conseille, place le code qui crée l'archive à la place de la ligne ... 'suite du traitement, sinon, forcément, il ne se passera rien...

Merci pour la réponse ! Voici tout le code du bouton "Imprimer et Archiver"

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
Sub Archiver()
ActiveSheet.Unprotect "1"
Worksheets("Marchandises").PrintOut , Preview:=True
Application.Dialogs(xlDialogPrinterSetup).Show
 
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
 
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
 
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
 
strName = wsA.Range("A1").Value _
          & " Mrch " & wsA.Range("A2").Value _
 
'create default name for savng file
strFile = strName & Format(Now(), "yyyy-mm-dd hh.mm.ss")
strPathFile = strPath & strFile
 
'export to PDF in current folder
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        filename:=strPathFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "Un archive a été créé au format PDF : " _
      & vbCrLf _
      & strPathFile
Sheets("Marchandises").Range("C4:D4").ClearContents
Sheets("Marchandises").Range("C6:D6").ClearContents
Sheets("Marchandises").Range("C8:D8").ClearContents
Sheets("Marchandises").Range("G6").ClearContents
Sheets("Marchandises").Range("TbloExtens").ClearContents
Sheets("Marchandises").Range("G4").Value = Sheets("Marchandises").Range("G4").Value + 1
exitHandler:
    Exit Sub
errHandler:
    MsgBox "Impossible de générer l'archive (fichier PDF)"
    Resume exitHandler
ActiveSheet.Protect "1", True, True, True
End Sub

Amicalement
RJSCVF

Je n'ai pas vérifié tout ton code, me contenant d'en réorganiser les blocs, en supprimant notamment le EXIT SUB (à bannir de ton code *). Je ne comprends pas bien pourquoi le Preview puis le choix de l'imprimante, mais bon.

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
Sub Archiver()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
 
  On Error GoTo EndHandler
  ActiveSheet.Unprotect "1"
  Worksheets("Marchandises").PrintOut , Preview:=True
  If Application.Dialogs(xlDialogPrinterSetup).Show() Then
    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet
 
    'get active workbook folder, if saved
    strPath = wbA.Path
    If strPath = "" Then
      strPath = Application.DefaultFilePath
    End If
    strPath = strPath & "\"
 
    strName = wsA.Range("A1").Value _
    & " Mrch " & wsA.Range("A2").Value _
 
    'create default name for savng file
    strFile = strName & Format(Now(), "yyyy-mm-dd hh.mm.ss")
    strPathFile = strPath & strFile
 
    'export to PDF in current folder
    wsA.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=strPathFile, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "Un archive a été créé au format PDF : " & vbCrLf & strPathFile
    Sheets("Marchandises").Range("C44").ClearContents
    Sheets("Marchandises").Range("C66").ClearContents
    Sheets("Marchandises").Range("C88").ClearContents
    Sheets("Marchandises").Range("G6").ClearContents
    Sheets("Marchandises").Range("TbloExtens").ClearContents
    Sheets("Marchandises").Range("G4").Value = Sheets("Marchandises").Range("G4").Value + 1
  End If
 
EndHandler:
  If Err <> 0 Then MsgBox "Impossible de générer l'archive (fichier PDF)"
  ActiveSheet.Protect "1", True, True, True
End Sub

* Pas d'EXIT SUB, jamais. Pourquoi? Si tu observes ton code, tu verras que la dernière ligne de ton code (ActiveSheet.Protect "1", True, True, True ne sera JAMAIS exécutée. Dans le code que je te fournis, elle le sera TOUJOURS...

25/09/2019, 10h56
RJSCVF

Une aide très précieuse !

Merci pour ton aide en corrigeant mon code.
Je n'aurai jamais su, vu mon niveau de VBA que la dernière ligne ne s'exécuterait jamais.
Et je aussi enlevé Preview, je me compliquais pour rien.
J'ai donc remplacé tout le code de ce bouton par celui que tu a modifié, mais en enlevant le Preview conformément à ta remarque.
Une fois encore merci pour ton aide.
Amicalement
RJSCVF