[Résolu] Plusieurs zones d'impression dans un Array

Kim75 · 18 Décembre 2016

Bonjour le forum,

Le but de la macro est d’imprimer des zones d’impressions mises dans un « Array » afin de pouvoir sélectionner celles qu’on veut imprimer

L’impression doit pouvoir se faire de deux manières au choix soit directement vers l’imprimante, soit exportée en un seul et unique fichier pdf

La sélection se fait via des checkbox qui alimentent cet « Array » , mais je rencontre 2 problèmes si quelqu'un pourrait me filer un coup de main :

-1. Le premier est que le preview de l'impression directe se fait en plusieurs sections au lieu d'une seule lorsqu'il y a plusieurs zones à imprimer

-2. Le second est que l'impression pdf ne contient que la dernière zone mise dans l' « Array » , au lieu de toutes les zones incluses normalement

VB:

Private Sub PaperPrint_Click()
Dim i As Integer, Cpt As Long, Ar() As String, Clct As Collection, j As Integer, Ctrl As Control
For Each Ctrl In Controls
    If Left(Ctrl.Name, 8) = "CheckBox" Then
        j = j - (Ctrl.Value = False)
        If j = 12 Then
            MsgBox "Oops, aucune feuille n'a été sélectionné !"
            Exit Sub
        End If
    End If
Next Ctrl
Set Clct = New Collection
If CheckBox1.Value = True Then Clct.Add "$A$1:$ET$119"
If CheckBox2.Value = True Then Clct.Add "$A$121:$ET$239"
If CheckBox3.Value = True Then Clct.Add "$A$241:$ET$359"
If CheckBox4.Value = True Then Clct.Add "$A$361:$ET$479"
If CheckBox5.Value = True Then Clct.Add "$A$481:$ET$599"
If CheckBox6.Value = True Then Clct.Add "$A$601:$ET$719"
If CheckBox7.Value = True Then Clct.Add "$A$721:$ET$839"
If CheckBox8.Value = True Then Clct.Add "$A$841:$ET$959"
If CheckBox9.Value = True Then Clct.Add "$A$961:$ET$1079"
If CheckBox10.Value = True Then Clct.Add "$A$1081:$ET$1199"
If CheckBox11.Value = True Then Clct.Add "$A$1201:$ET$1319"
If CheckBox12.Value = True Then Clct.Add "$A$1321:$ET$1439"
Cpt = Clct.Count
ReDim Ar(Cpt)
For i = 1 To Cpt
    Ar(i - 1) = Clct(i)
Next i
Application.ScreenUpdating = False
Me.Hide
For i = 0 To UBound(Ar) - 1
    Sheets("Plans").PageSetup.PrintArea = Ar(i)
    Sheets("Plans").PrintPreview
Next i
Me.Show
Application.ScreenUpdating = True
Set Clct = Nothing
Unload Me
End Sub

Private Sub PdfPrint_Click()
Dim sNomFichierPDF As String, i As Long, Cpt As Long, Ar() As String, Clct As Collection, j As Integer, Ctrl As Control
For Each Ctrl In Controls
    If Left(Ctrl.Name, 8) = "CheckBox" Then
        j = j - (Ctrl.Value = False)
        If j = 12 Then
            MsgBox "Oops, aucune feuille n'a été sélectionné !"
            Exit Sub
        End If
    End If
Next Ctrl
sNomFichierPDF = ThisWorkbook.Path & "\" & "Plans_Etages.pdf"
If Dir(sNomFichierPDF) = "" Then
    Set Clct = New Collection
    If CheckBox1.Value = True Then Clct.Add "$A$1:$ET$119"
    If CheckBox2.Value = True Then Clct.Add "$A$121:$ET$239"
    If CheckBox3.Value = True Then Clct.Add "$A$241:$ET$359"
    If CheckBox4.Value = True Then Clct.Add "$A$361:$ET$479"
    If CheckBox5.Value = True Then Clct.Add "$A$481:$ET$599"
    If CheckBox6.Value = True Then Clct.Add "$A$601:$ET$719"
    If CheckBox7.Value = True Then Clct.Add "$A$721:$ET$839"
    If CheckBox8.Value = True Then Clct.Add "$A$841:$ET$959"
    If CheckBox9.Value = True Then Clct.Add "$A$961:$ET$1079"
    If CheckBox10.Value = True Then Clct.Add "$A$1081:$ET$1199"
    If CheckBox11.Value = True Then Clct.Add "$A$1201:$ET$1319"
    If CheckBox12.Value = True Then Clct.Add "$A$1321:$ET$1439"
    Cpt = Clct.Count
    ReDim Ar(Cpt)
    For i = 1 To Cpt
        Ar(i - 1) = Clct(i)
    Next i
    Application.ScreenUpdating = False
    For i = 0 To UBound(Ar) - 1
        Sheets("Plans").PageSetup.PrintArea = Ar(i)
        Sheets("Plans").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNomFichierPDF, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next i
    Application.ScreenUpdating = True
    Set Clct = Nothing
    MsgBox "La sélection de plans a été éditée au format Pdf," & vbCrLf & vbCrLf & "Le fichier Plans_Etages.pdf est dans ce répertoire !", vbOKOnly + vbInformation, "  Information !"
    Unload Me
Else
    MsgBox "Un fichier Plans_Etages.pdf existe dans ce répertoire," & vbCrLf & vbCrLf & "Merci de le renommer ou de le déplacer et de réessayer !", vbOKOnly + vbExclamation, "  Attention !"
End If
End Sub

Cordialement, Kim.

Lone-wolf · 18 Décembre 2016

Bonjour Kim

Pour les zones d'impressions, je pense que le plus s'imple, c'est qu'il faut supprimer la boucle; et pour chaque CheckBox
With Sheets("Plans")
If ChecBox1 Then .PageSetup.PrintArea = "$A$1:$ET$119"
ElseIf ChecBox2 Then .PageSetup.PrintArea = "$A$121:$ET$239"
ElseIf ChecBox3 Then .PageSetup.PrintArea = XXXX
Idem pour les autres
End With

Oubien essaier

Dim x As Integer
x = 0

For i = 0 To UBound(Ar) - 1
x = x + 1
Sheets("Plans").PageSetup.PrintArea = Ar(x)

Kim75 · 18 Décembre 2016

Hello Lone-Wolf

Merci pour le tuyau, toujours au point mort ...

Cordialement, Kim.

Lone-wolf · 18 Décembre 2016

Re Kim

Tu as sûrement mal réécrit la macro. Chez moi j'ai bien 1 niveau à la fois qui s'affiche.

VB:

Option Explicit
Dim Wks As Worksheet, PgS

Private Sub PdfPrint_Click()
Dim sNomFichierPDF As String, i As Long, Cpt As Long,  _
Ar() As String,  j As Integer, Ctrl As Control

For Each Ctrl In Controls
    If Left(Ctrl.Name, 8) = "CheckBox" Then
        j = j - (Ctrl.Value = False)
        If j = 12 Then
            MsgBox "Oops, aucune feuille n'a été sélectionné !"
            Exit Sub
        End If
    End If
Next Ctrl

sNomFichierPDF = ThisWorkbook.Path & "\" & "Plans_Etages.pdf"
If Dir(sNomFichierPDF) = "" Then
Set Wks = Sheets("Plans")
Wks.Activate
PgS = ActiveSheet.PageSetup.PrintArea

  If CheckBox1 Then PgS = "$A$1:$ET$119"
  ElseIf CheckBox2 Then PgS = "$A$121:$ET$239"
  ElseIf CheckBox3 Then PgS = "$A$241:$ET$359"
  ElseIf CheckBox4 Then PgS = "$A$361:$ET$479"
  ElseIf CheckBox5 Then PgS = "$A$481:$ET$599"
  ElseIf CheckBox6 Then PgS = "$A$601:$ET$719"
  ElseIf CheckBox7 Then PgS = "$A$721:$ET$839"
  ElseIf CheckBox8 Then PgS = "$A$841:$ET$959"
  ElseIf CheckBox9 Then PgS = "$A$961:$ET$1079"
  ElseIf CheckBox10 Then PgS = "$A$1081:$ET$1199"
  ElseIf CheckBox11 Then PgS = "$A$1201:$ET$1319"
  ElseIf CheckBox12 Then PgS = "$A$1321:$ET$1439"
  End If


        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNomFichierPDF, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Application.ScreenUpdating = True

    MsgBox "La sélection de plans a été éditée au format Pdf," & vbCrLf & vbCrLf & "Le fichier Plans_Etages.pdf est dans ce répertoire !", vbOKOnly + vbInformation, "  Information !"
    Unload Me
Else
    MsgBox "Un fichier Plans_Etages.pdf existe dans ce répertoire," & vbCrLf & vbCrLf & "Merci de le renommer ou de le déplacer et de réessayer !", vbOKOnly + vbExclamation, "  Attention !"
End If
End Sub

Kim75 · 18 Décembre 2016

Hello Lone-Wolf

Je ne sais pas ce que tu as compris ni ce que tu as fait je ne vois pas l'intérêt de ne pouvoir imprimer qu'une seule printarea lorsqu'on coche plusieurs checkboxes, c'est à dire lorsqu'on choisit d'en imprimer plusieurs

Cordialement, Kim.

Lone-wolf · 18 Décembre 2016

C'est toi qui bagasse...

Que dit la macro que j'ai modifié??? Réfléchi bien; moi à l'impression j'ai bien les sélections choisies. Pour le voir, il faut fermer l'aperçu de chaque sélection.

Kim75 · 18 Décembre 2016

Lone-Wolf

Franchement je ne vois pas de quoi tu parles
Pourquoi ne postes-tu pas le fichier avec le code que tu dis être bon ?
Je te rappelle que le but est de pouvoir imprimer plusieurs printarea assemblées en un seul fichier
Pourquoi ne testes-tu pas le fichier chez toi en cochant plusieurs checkboxes et ne lnces-tu pas l'impression pdf ?
Pourquoi ne vas-tu pas ouvrir le fichier Pdf généré pour voir s'il contient effectivement les multiples printarea que tu as cochées ?

Cordialement, Kim.

job75 · 18 Décembre 2016

Bonsoir Kim75, Lone-wolf,

Pour tester faites une copie de votre fichier et remplacez vos macros PdfPrint_Click et PaperPrint_Click par ce code :

Code:

Private Sub PdfPrint_Click()
Zones True
End Sub

Private Sub PaperPrint_Click()
Zones False
End Sub

Sub Zones(pdf As Boolean)
Dim a, i As Byte, z$, fichier$, existe As Boolean
a = Array("A1:ET119", "A121:ET239", "A241:ET359", "A361:ET479", "A481:ET599", "A601:ET719", _
"A721:ET839", "A841:ET959", "A961:ET1079", "A1081:ET1199", "A1201:ET1319", "A1321:ET1439")
For i = 1 To 12
  If Me("Checkbox" & i) Then z = z & "," & a(i - 1)
Next
If z = "" Then MsgBox "Aucun plan sélectionné...": Exit Sub
With Sheets("Plans")
  With .PageSetup
    .PrintArea = Mid(z, 2) 'zone d'impression
    .CenterHorizontally = True
    .CenterVertically = True
    .Orientation = xlLandscape 'xlPortrait
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
  End With
  If pdf Then
    fichier = ThisWorkbook.Path & "\" & "Plans_Etages.pdf"
    existe = Dir(fichier) <> ""
    If existe Then If MsgBox("Le fichier 'Plans_Etages.pdf' existe déjà, voulez-vous le modifier ?", 4) = 7 Then Exit Sub
    .ExportAsFixedFormat xlTypePDF, fichier
    MsgBox "Le fichier 'Plans_Etages.pdf' a été " & IIf(existe, "modifié...", "créé...")
  Else
    Me.Hide
    .PrintPreview 'pour tester
    '.PrintOut 'pour imprimer
  End If
End With
Unload Me
End Sub

A+

Kim75 · 18 Décembre 2016

Hello Job !

Bravo mon cher, rien à dire si ce n'est un grand MERCI !
Le code est tellement bien fait qu'on est forcé de ne pas l'oublier

Cordialement, Kim.

Lone-wolf · 18 Décembre 2016

Bonsoir job

job75 · 18 Décembre 2016

Re,

J'avais compliqué inutilement la formule de la zone d'impression, j'ai corrigé.

A+

Kim75 · 18 Décembre 2016

Hello Job, Lone-Wolf, le forum,

Oui j'ai vu que tu as remplacé et repositionné au bon endroit le :

VB:

.PrintArea = .Range(Mid(z, 2)).Address

par

VB:

.PrintArea = Mid(z, 2)

En tout les cas, la macro fonctionne nickel, comme sur des roulettes
Merci pour l'aide apportée, et merci aussi à Lone-Wolf de s'y être impliqué

Cordialement, Kim.

job75 · 18 Décembre 2016

Re,

Ce n'est pas une question d'endroit, au post #8 la formule est maintenant plus simple :

Code:

 .PrintArea = Mid(z, 2) 'zone d'impression

Bonne nuit.

Kim75 · 18 Décembre 2016

Hello Job !
Oui effectivement, j'ai bien vu
Bonne nuit et merci encore !
Kim.

Lone-wolf · 19 Décembre 2016

Re

D'après l'exemple de job75, (une autre façon de faire) mais sans formulaire. Mettez le pdf sur le bureau.

Après avoir double-cliqué sur la feuille, cliquez sur l'icône excel dans la barre des tâches pour afficher le message, ensuite faite votre choix.

[Résolu] Plusieurs zones d'impression dans un Array

Kim75

XLDnaute Occasionnel

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

Kim75

XLDnaute Occasionnel

Lone-wolf

XLDnaute Barbatruc

Kim75

XLDnaute Occasionnel

Lone-wolf

XLDnaute Barbatruc

Kim75

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Kim75

XLDnaute Occasionnel

Lone-wolf

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Kim75

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Kim75

XLDnaute Occasionnel

Lone-wolf

XLDnaute Barbatruc

Pièces jointes

Discussions similaires