XL 2016 Excel VBA - Macro imprimer si cellule différente de 0

jrmy34 · 8 Septembre 2019

Bonjour à la communauté !

J'ai un fichier qui contient plusieurs feuilles. Su ma feuille "Accueil" qui me sert de Menu, j'ai ajouté un bouton imprimer. Il m'imprime donc ma sélection de feuille demandé.

Néanmoins, il m'imprime les feuilles qu'il y ait qqch d'écris ou non, ce qui fait du gaspillage de papier. Je souhaiterai donc pouvoir dire :

Tu imprimes uniquement les feuilles de la sélection que je t'impose dont B16 est différent de 0.

Voici mon code actuelle qui fonctionne et que je souhaiterai compléter avec ma condition :

Private Sub CommandButton1_Click()
CarryOn = MsgBox("Voulez-vous imprimer TOUS les Ateliers ?", vbYesNo, "Kutools for Excel") 'Message pour confirmer l'impression en oui/non
If CarryOn = vbYes Then 'si oui alors ...imprimer!
Worksheets(Array("A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10", "A11", "A12", "A13", "A14", "A15", "A16", "A17", "A18", "A19", "A20", "A21", "A22", "A23", "A24", "A25")).PrintOut Copies:=1, ActivePrinter:="PDFCreator" 'Sélection des feuilles à imprimer
End If
End Sub

D'avance un tout grand merci à vous !!!

Robert · 8 Septembre 2019

Bonjour Jrmy, bonjour le forum,

Essaie comme ça :

VB:

CarryOn = MsgBox("Voulez-vous imprimer TOUS les Ateliers ?", vbYesNo, "Kutools for Excel") 'Message pour confirmer l'impression en oui/non
If CarryOn = vbYes Then 'si oui alors ...imprimer!
    For Each O In Worksheets
        Select Case O.Name
            Case "A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10", "A11", "A12", "A13", "A14", _
               "A15", "A16", "A17", "A18", "A19", "A20", "A21", "A22", "A23", "A24", "A25"
               If O.Range("B16") <> "" Then O.PrintOut Copies:=1, ActivePrinter:="PDFCreator" 'Sélection des feuilles à imprimer
        End Select
    Next O
End If
End Sub

danielco · 8 Septembre 2019

Bonjour,

VB:

Private Sub CommandButton1_Click()
CarryOn = MsgBox("Voulez-vous imprimer TOUS les Ateliers ?", vbYesNo, "Kutools for Excel") 'Message pour confirmer l'impression en oui/non
If CarryOn = vbYes Then 'si oui alors ...imprimer!
'Worksheets(Array("A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10", "A11", "A12", "A13", "A14", "A15", "A16", "A17", "A18", "A19", "A20", "A21", "A22", "A23", "A24", "A25")).PrintOut Copies:=1, ActivePrinter:="PDFCreator" 'Sélection des feuilles à imprimer
  For Each sh In Worksheets(Array("A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10", "A11", "A12", "A13", "A14", "A15", "A16", "A17", "A18", "A19", "A20", "A21", "A22", "A23", "A24", "A25"))
    If sh.[B16] <> 0 Then
      sh.PrintOut Copies:=1, ActivePrinter:="PDFCreator"
    End If
  Next sh
End If
End Sub

Mais ça crée peut-être plusieurs documents ?

Cordialement.

Daniel

Robert · 8 Septembre 2019

Re,

Peut-être. Je n'ai pas testé...

danielco · 8 Septembre 2019

Essaie :

VB:

Private Sub CommandButton1_Click()
Dim Sh As Worksheet, Tabl() As String, Ctr As Integer
CarryOn = MsgBox("Voulez-vous imprimer TOUS les Ateliers ?", vbYesNo, "Kutools for Excel") 'Message pour confirmer l'impression en oui/non
Ctr = -1
If CarryOn = vbYes Then 'si oui alors ...imprimer!
  For Each Sh In Worksheets(Array("A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10", "A11", "A12", "A13", "A14", "A15", "A16", "A17", "A18", "A19", "A20", "A21", "A22", "A23", "A24", "A25"))
    If Sh.[B16] <> 0 Then
      Ctr = Ctr + 1
      ReDim Preserve Tabl(Ctr)
      Tabl(Ctr) = Sh.Name
    End If
  Next Sh
  Worksheets(Tabl).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
End If
End Sub

jrmy34 · 8 Septembre 2019

Wawou super les gars !!!
Effectivement, la première proposition créé plusieurs fichier PDF, la seconde n'en créé qu'un !
Un grand merci pour votre efficacité à tous les deux !

jrmy34 · 8 Septembre 2019

jrmy34 à dit:
Wawou super les gars !!!
Effectivement, la première proposition créé plusieurs fichier PDF, la seconde n'en créé qu'un !
Un grand merci pour votre efficacité à tous les deux !

XL 2016 Excel VBA - Macro imprimer si cellule différente de 0

jrmy34

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

danielco

XLDnaute Accro

Robert

XLDnaute Barbatruc

danielco

XLDnaute Accro

jrmy34

XLDnaute Nouveau

jrmy34

XLDnaute Nouveau

Discussions similaires