Impression d'une feuille: Ne pas imprimer certaines cellules.

GuillaumA

XLDnaute Occasionnel
Bonjour à tous,

Ci-joint mon code d'impression:
Code:
Sub Print()
Dim P As Byte
P = MsgBox(Range("Database!K33"), vbYesNo + vbDefaultButton1)
If P = vbNo Then Exit Sub

Application.Dialogs(xlDialogPrinterSetup).Show
With Sheets("Action Plan")
.PageSetup.PrintArea = "$B$1:$Q$610"
With .PageSetup
.PaperSize = xlPaperA4
.Orientation = xlLandscape
.FitToPagesWide = 1
.BlackAndWhite = True
End With
.PrintOut Copies:=1
End With

End Sub

Je voudrai que le texte présent en colonne D (D:D) ne s'affiche pas sur les feuilles imprimé. En effet il s'agit de formules cachés (écrite en blanc sur fond blanc et protégé).

Existe t'il une fonction pour cela ?

Amicalement,
Guillaume
 

GuillaumA

XLDnaute Occasionnel
Re : Impression d'une feuille: Ne pas imprimer certaines cellules.

Bonjour Softmama,
Je suis dans l'incapacité de tester ta solution aujourd'hui mais le ferai dès demain matin 9h.

- Il faudrait en effet nommer les pavé (ex: PAV_number) et les effacer (ActiveSheet.DrawingObjects.Delete commencant par PAV*)
- Les lignes définissant les blocs de 5 sont remplis, pour les cellules blanches par des formules et pour la ligne de couleur, par du texte.

Quoi qu'il en soit, un immense merci pour cette macro, je n'en attendai pas autant! J'ai hâte de pouvoir la tester, en espérant que créer des tonnes de boutons pour les effacer ensuite ne fera pas trop ramer l'excel!

Amicalement,
Guillaume
 

Softmama

XLDnaute Accro
Re,

Donc en implémentant une boucle qui vient effacer les pavés créés, un à un, après l'impression :
VB:
Sub Print()
Dim P As Byte, t as Integer, u as Integer, Lignes()
P = MsgBox(Range("Database!K33"), vbYesNo + vbDefaultButton1)
If P = vbNo Then Exit Sub
Application.Dialogs(xlDialogPrinterSetup).Show
With Sheets("Action Plan")
  Lignes() = Array(8, 49, 105, 113) 'mettre les lignes de départ de chaque tableau + ligne de fin du dernier tableau +5
  For t = 0 To UBound(Lignes) - 1
    For u = Lignes(t) To Lignes(t + 1) - 5 Step 3
        .Shapes.AddShape(msoShapeRectangle, .Range("B1").Left, Range("B" & u).Top, Columns("B:D").Width, .Range("B" & u).Height).Select 'On colle un pavé au bon endroit
        Selection.Name = "Gniarf" & t & "_" & u 'on lui donne un nom
        Selection.ShapeRange.Line.Visible = msoFalse 'on voit plus les bordures
    Next u
  Next t
  .PageSetup.PrintArea = "$B$1:$Q$610"
  With .PageSetup
    .PaperSize = xlPaperA4
    .Orientation = xlLandscape
    .FitToPagesWide = 1
    .BlackAndWhite = True
  End With
  .PrintOut Copies:=1
  For t = 0 To UBound(Lignes) - 1 'Boucle d'effacement des pavés créés
    For u = Lignes(t) To Lignes(t + 1) - 5 Step 3
        .Shapes("Gniarf" & t & "_" & u).Delete
    Next u
  Next t
End With
End Sub

Par contre, pour pouvoir se passer du Lignes() = Array(...), je manque encore d'infos. Je pense qu'une toute petite extraction de ton fichier pour me montrer comment il est structuré m'aiderait, pque pour le moment, je suis trop dans le flou.

[Edit] Quant à la rapidité de la macro, je pense que même avec quelques centaines de pavés, elle ne devrait pas prendre plus d'une ou 2 secondes.
[Edit2] Si jamais cela faisait néanmoins trop ramer ton pc, il resterait la version Tableau() que l'on a je pense trop vite écartée et qui, même si elle est plus moche, restera la moins gourmande et la plus rapide. Faudra juste copier les formules au lieu des valeurs pour qu'elle fonctionne.
 
Dernière édition:

Softmama

XLDnaute Accro
Re,

Donc une version un peu 'bourrin' de la méthode Tableau() pourrait donner ceci :

VB:
Sub Print()
Dim P As Byte, t as Integer, u as Integer, Lignes(), Tableau()
P = MsgBox(Range("Database!K33"), vbYesNo + vbDefaultButton1)
If P = vbNo Then Exit Sub
Application.Dialogs(xlDialogPrinterSetup).Show
'************ 1- on garde ttes les données ds un tableau
  Tableau = Range("B1:D690").Formula
With Sheets("Action Plan")
  Lignes() = Array(8, 49, 105, 113) 'mettre les lignes de départ de chaque tableau + ligne de fin du dernier tableau +5
'************ 2- on efface les cellules qu'on veut masquer
  For t = 0 To UBound(Lignes) - 1
    For u = Lignes(t) To Lignes(t + 1) - 5 Step 3
        .Range("B" & u).Resize(, 3) = ""
    Next u
  Next t
'************ 3- on gère alors l'impression
  .PageSetup.PrintArea = "$B$1:$Q$610"
  With .PageSetup
    .PaperSize = xlPaperA4
    .Orientation = xlLandscape
    .FitToPagesWide = 1
    .BlackAndWhite = True
  End With
  .PrintOut Copies:=1
'************ 4- puis on remet les valeurs d'origine *******
Range("B1:D690").Formula = Tableau()
End With
End Sub

A toi de voir...
 

Discussions similaires

Statistiques des forums

Discussions
312 215
Messages
2 086 319
Membres
103 177
dernier inscrit
grizly