Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel macro pas imprimer si vide

macro pas imprimer si vide

9 réponses
Avatar
surplus
Bonjour,
j'ai une macro imprimer je voudrais ne pas imprimer les valeurs vides du tableau ces données sont en A6:D38 sur ma feuille dans la macro sont en A2 F34 je pense je voudrais si possible ne pas imprimer ces données vides de ce tableau
Sub imprim(Nom As String)
Dim inCalculationMode As Integer
Application.ScreenUpdating = False
inCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
With Sheets("conges")
x = 0
y = Application.Match(Nom, .Rows(7), 0) - 1
End With
For Each sh In Sheets
If sh.Name = "Temp" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next sh
Sheets.Add
ActiveSheet.Name = "Temp"
With Sheets("Feuil1")
[conges!A6:D38].Offset(x, y).Copy [B1]
For Each c In [A2:F34]
If c.Value = 0 Then c.Value = ""
Next c
Columns(1).ColumnWidth = 18.57
Columns(3).ColumnWidth = 3.86
Columns(4).ColumnWidth = 4.86

Set c = .Range("B71:Y82").Find(Nom, , , xlWhole)
x = c.Row - 71
y = c.Column - 2
If y > 0 Then y = 15
[A35] = .[B71].Offset(x, y)
[A35].Font.Bold = True
[A35].Interior.ColorIndex = .[B71].Offset(x, y).Interior.ColorIndex
[A35].Font.ColorIndex = .[B71].Offset(x, y).Font.ColorIndex
[A35].HorizontalAlignment = xlCenter
If y = 15 Then y = 23
[E35] = .[Q71].Offset(x, y)
[E35].Font.Bold = True
[E35].Interior.ColorIndex = .[Q71].Offset(x, y).Interior.ColorIndex
[E35].Font.ColorIndex = .[Q71].Offset(x, y).Font.ColorIndex
[E35].HorizontalAlignment = xlCenter
If y = 23 Then y = 24
[F35] = .[U71].Offset(x, y)
[F35].Font.Bold = True
[F35].Interior.ColorIndex = .[U71].Offset(x, y).Interior.ColorIndex
[F35].Font.ColorIndex = .[U71].Offset(x, y).Font.ColorIndex
[F35].HorizontalAlignment = xlCenter
[G35] = .[Y71].Offset(x, y)
[G35].Font.Bold = True
[G35].Interior.ColorIndex = .[Y71].Offset(x, y).Interior.ColorIndex
[G35].Font.ColorIndex = .[Y71].Offset(x, y).Font.ColorIndex
[G35].HorizontalAlignment = xlCenter
[A34] = "Conges"
[E34] = "acquis"
[F34] = "pris"
[G34] = "restants"
[A34:G34].HorizontalAlignment = xlCenter
[A34:G34].Font.Size = 12
[A34:G34].Font.Bold = True
End With
[A35:G35].BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic, _
Weight:=xlMedium
[B1:C1].EntireColumn.AutoFit
[1:5].Insert
[A2:G2].Merge
[A2].HorizontalAlignment = xlCenter
[A2] = "le " & Format(Date, "DD MMMM YYYY")
[A2].Font.Bold = True
[A2].Font.Size = 14
[A44] = "le salarié"
[G44] = "la direction"
[A44:G44].Font.Size = 12
ActiveSheet.PageSetup.LeftHeaderPicture.Filename = _
"C:\Documents and Settings\EUSEBIO\Bureau\a envoyer\logo.gif"
'Application.PrintCommunication = False
With ActiveSheet.PageSetup.LeftHeaderPicture
.Height = 70.57
'.Width = 57.43
End With
With ActiveSheet.PageSetup
.LeftHeader = _
"&G" & Chr(10) & "&""-,Gras""& EVOLUTION AUTO" & Chr(10) & "Rue Emile Delamarre Debouteville" & Chr(10) & "Z.I.Croix Sud" & Chr(10) & _
"11100 NARBONNE&""-,Normal""&11" & Chr(10) & "&10Tél:04 68 42 29 00" & Chr(10) & "&10Fax:04 68 41 37 27"
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(2.38)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
End With

DoEvents
Application.ScreenUpdating = True
ActiveSheet.PrintPreview
'ActiveSheet.PrintOut
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.Calculation = inCalculationMode
End Sub
Signaler un problème avec ce contenu

9 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
MichD
Bonjour,

Je n'ai repris que l'essentiel de ce que pourrait contenir ta macro
pour cacher les lignes affichant seulement des 0

En fait, j'insère une formule dans la colonne G et je masque les lignes
qui affichent la valeur "E".

Tu adaptes la procédure pour insérer tes lignes de formatage...

'--------------------------------------------------------------
Sub test()
Dim Rg As Range

With Worksheets("Feuil1")
'Définit où on ajoute les formules
Set Rg = .Range("G2:G34")
End With
'Insère la formule dans la plage
Rg.Formula = "=if(countif(" & Rg(1).Offset(, -6). _
Resize(, 6).Rows(1).Address(0, 0) & ",0)=6,1,""E"")"

'Masque les lignes qui affiche un résultat "E"
Rg.SpecialCells(xlCellTypeFormulas, 2).EntireRow.Hidden = True

'Et pour définir la plage d'impression
With Worksheets("Feuil1")
'Défini la plage à imprimer
.PageSetup.PrintArea = .Range("A2:F34").Address
.PrintPreview 'Tu remplaces par .Print après les tests
'Après impression
.PageSetup.PrintArea = ""
End With

'Pour afficher toutes les lignes
With Worksheets("Feuil1")
.Range("A2:F34").EntireRow.Hidden = False
.Range("G2:G34").ClearContents
End With
End Sub
'--------------------------------------------------------------






MichD
--------------------------------------------
"surplus" a écrit dans le message de groupe de discussion :

Bonjour,
j'ai une macro imprimer je voudrais ne pas imprimer les valeurs vides du
tableau ces données sont en A6:D38 sur ma feuille dans la macro sont en A2 F34
je pense je voudrais si possible ne pas imprimer ces données vides de ce
tableau
Sub imprim(Nom As String)
Dim inCalculationMode As Integer
Application.ScreenUpdating = False
inCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
With Sheets("conges")
x = 0
y = Application.Match(Nom, .Rows(7), 0) - 1
End With
For Each sh In Sheets
If sh.Name = "Temp" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next sh
Sheets.Add
ActiveSheet.Name = "Temp"
With Sheets("Feuil1")
[conges!A6:D38].Offset(x, y).Copy [B1]
For Each c In [A2:F34]
If c.Value = 0 Then c.Value = ""
Next c
Columns(1).ColumnWidth = 18.57
Columns(3).ColumnWidth = 3.86
Columns(4).ColumnWidth = 4.86

Set c = .Range("B71:Y82").Find(Nom, , , xlWhole)
x = c.Row - 71
y = c.Column - 2
If y > 0 Then y = 15
[A35] = .[B71].Offset(x, y)
[A35].Font.Bold = True
[A35].Interior.ColorIndex = .[B71].Offset(x, y).Interior.ColorIndex
[A35].Font.ColorIndex = .[B71].Offset(x, y).Font.ColorIndex
[A35].HorizontalAlignment = xlCenter
If y = 15 Then y = 23
[E35] = .[Q71].Offset(x, y)
[E35].Font.Bold = True
[E35].Interior.ColorIndex = .[Q71].Offset(x, y).Interior.ColorIndex
[E35].Font.ColorIndex = .[Q71].Offset(x, y).Font.ColorIndex
[E35].HorizontalAlignment = xlCenter
If y = 23 Then y = 24
[F35] = .[U71].Offset(x, y)
[F35].Font.Bold = True
[F35].Interior.ColorIndex = .[U71].Offset(x, y).Interior.ColorIndex
[F35].Font.ColorIndex = .[U71].Offset(x, y).Font.ColorIndex
[F35].HorizontalAlignment = xlCenter
[G35] = .[Y71].Offset(x, y)
[G35].Font.Bold = True
[G35].Interior.ColorIndex = .[Y71].Offset(x, y).Interior.ColorIndex
[G35].Font.ColorIndex = .[Y71].Offset(x, y).Font.ColorIndex
[G35].HorizontalAlignment = xlCenter
[A34] = "Conges"
[E34] = "acquis"
[F34] = "pris"
[G34] = "restants"
[A34:G34].HorizontalAlignment = xlCenter
[A34:G34].Font.Size = 12
[A34:G34].Font.Bold = True
End With
[A35:G35].BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic, _
Weight:=xlMedium
[B1:C1].EntireColumn.AutoFit
[1:5].Insert
[A2:G2].Merge
[A2].HorizontalAlignment = xlCenter
[A2] = "le " & Format(Date, "DD MMMM YYYY")
[A2].Font.Bold = True
[A2].Font.Size = 14
[A44] = "le salarié"
[G44] = "la direction"
[A44:G44].Font.Size = 12
ActiveSheet.PageSetup.LeftHeaderPicture.Filename = _
"C:Documents and SettingsEUSEBIOBureaua envoyerlogo.gif"
'Application.PrintCommunication = False
With ActiveSheet.PageSetup.LeftHeaderPicture
.Height = 70.57
'.Width = 57.43
End With
With ActiveSheet.PageSetup
.LeftHeader = _
"&G" & Chr(10) & "&""-,Gras""& EVOLUTION AUTO" & Chr(10) & "Rue Emile
Delamarre Debouteville" & Chr(10) & "Z.I.Croix Sud" & Chr(10) & _
"11100 NARBONNE&""-,Normal""&11" & Chr(10) & "&10Tél:04 68 42 29 00" &
Chr(10) & "&10Fax:04 68 41 37 27"
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(2.38)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
End With

DoEvents
Application.ScreenUpdating = True
ActiveSheet.PrintPreview
'ActiveSheet.PrintOut
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.Calculation = inCalculationMode
End Sub
Avatar
MichD
si tu veux seulement masquer les zéros de ta feuille le temps que durera l'impression :

'----------------------------
Sub Les_Zéros()

'Masque les 0
ActiveWindow.DisplayZeros = False

Ta procédure d'impression

'Affiche les zéros
ActiveWindow.DisplayZeros = True

End Sub
'----------------------------

MichD
--------------------------------------------
Sub
Avatar
surplus
MichD a écrit le 13/03/2011 à 17h47 :
si tu veux seulement masquer les zéros de ta feuille le temps que durera
l'impression :

'----------------------------
Sub Les_Zéros()

'Masque les 0
ActiveWindow.DisplayZeros = False

Ta procédure d'impression

'Affiche les zéros
ActiveWindow.DisplayZeros = True

End Sub
'----------------------------

MichD
--------------------------------------------
Sub


masquer les 0 c'est fait je veux pas imprimer les lignes vides du tableau en fait
je vais adapter la formule et je verrai le resultat
merci
Avatar
surplus
surplus a écrit le 13/03/2011 à 19h43 :
MichD a écrit le 13/03/2011 à 17h47 :
si tu veux seulement masquer les zéros de ta feuille le temps que
durera
l'impression :

'----------------------------
Sub Les_Zéros()

'Masque les 0
ActiveWindow.DisplayZeros = False

Ta procédure d'impression

'Affiche les zéros
ActiveWindow.DisplayZeros = True

End Sub
'----------------------------

MichD
--------------------------------------------
Sub



masquer les 0 c'est fait je veux pas imprimer les lignes vides du tableau en
fait
je vais adapter la formule et je verrai le resultat
merci


dèsolè mais j'y arrive pas je sais pas ou placer les formules donnès
quelqu'un peut me les mettre sur la macro que j ai qu'un copier coller a faire?
merci
Avatar
MichD
| j'ai une macro imprimer je voudrais ne pas imprimer les valeurs vides du
| tableau ces données sont en A6:D38 sur ma feuille dans la macro sont en A2 F34

Ça, c'est du chinois pour moi.
Quel est le nom de la feuille où sont tes données ?
Quelle est la plage de cellules sur cette feuille ?

Quand tu lances ta macro, quel est le nom de ta feuille active ?
Tu écris des With ... End With mais dans ton code, tu n'utilises
pas le "POINT" dans les lignes subséquentes pour démonter à quelle
feuille appartient les objets situés entre le With et le End With

ça devient difficile de s'y retrouver !


MichD
--------------------------------------------
"surplus" a écrit dans le message de groupe de discussion :

Bonjour,
j'ai une macro imprimer je voudrais ne pas imprimer les valeurs vides du
tableau ces données sont en A6:D38 sur ma feuille dans la macro sont en A2 F34
je pense je voudrais si possible ne pas imprimer ces données vides de ce
tableau
Sub imprim(Nom As String)
Dim inCalculationMode As Integer
Application.ScreenUpdating = False
inCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
With Sheets("conges")
x = 0
y = Application.Match(Nom, .Rows(7), 0) - 1
End With
For Each sh In Sheets
If sh.Name = "Temp" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next sh
Sheets.Add
ActiveSheet.Name = "Temp"
With Sheets("Feuil1")
[conges!A6:D38].Offset(x, y).Copy [B1]
For Each c In [A2:F34]
If c.Value = 0 Then c.Value = ""
Next c
Columns(1).ColumnWidth = 18.57
Columns(3).ColumnWidth = 3.86
Columns(4).ColumnWidth = 4.86

Set c = .Range("B71:Y82").Find(Nom, , , xlWhole)
x = c.Row - 71
y = c.Column - 2
If y > 0 Then y = 15
[A35] = .[B71].Offset(x, y)
[A35].Font.Bold = True
[A35].Interior.ColorIndex = .[B71].Offset(x, y).Interior.ColorIndex
[A35].Font.ColorIndex = .[B71].Offset(x, y).Font.ColorIndex
[A35].HorizontalAlignment = xlCenter
If y = 15 Then y = 23
[E35] = .[Q71].Offset(x, y)
[E35].Font.Bold = True
[E35].Interior.ColorIndex = .[Q71].Offset(x, y).Interior.ColorIndex
[E35].Font.ColorIndex = .[Q71].Offset(x, y).Font.ColorIndex
[E35].HorizontalAlignment = xlCenter
If y = 23 Then y = 24
[F35] = .[U71].Offset(x, y)
[F35].Font.Bold = True
[F35].Interior.ColorIndex = .[U71].Offset(x, y).Interior.ColorIndex
[F35].Font.ColorIndex = .[U71].Offset(x, y).Font.ColorIndex
[F35].HorizontalAlignment = xlCenter
[G35] = .[Y71].Offset(x, y)
[G35].Font.Bold = True
[G35].Interior.ColorIndex = .[Y71].Offset(x, y).Interior.ColorIndex
[G35].Font.ColorIndex = .[Y71].Offset(x, y).Font.ColorIndex
[G35].HorizontalAlignment = xlCenter
[A34] = "Conges"
[E34] = "acquis"
[F34] = "pris"
[G34] = "restants"
[A34:G34].HorizontalAlignment = xlCenter
[A34:G34].Font.Size = 12
[A34:G34].Font.Bold = True
End With
[A35:G35].BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic, _
Weight:=xlMedium
[B1:C1].EntireColumn.AutoFit
[1:5].Insert
[A2:G2].Merge
[A2].HorizontalAlignment = xlCenter
[A2] = "le " & Format(Date, "DD MMMM YYYY")
[A2].Font.Bold = True
[A2].Font.Size = 14
[A44] = "le salarié"
[G44] = "la direction"
[A44:G44].Font.Size = 12
ActiveSheet.PageSetup.LeftHeaderPicture.Filename = _
"C:Documents and SettingsEUSEBIOBureaua envoyerlogo.gif"
'Application.PrintCommunication = False
With ActiveSheet.PageSetup.LeftHeaderPicture
.Height = 70.57
'.Width = 57.43
End With
With ActiveSheet.PageSetup
.LeftHeader = _
"&G" & Chr(10) & "&""-,Gras""& EVOLUTION AUTO" & Chr(10) & "Rue Emile
Delamarre Debouteville" & Chr(10) & "Z.I.Croix Sud" & Chr(10) & _
"11100 NARBONNE&""-,Normal""&11" & Chr(10) & "&10Tél:04 68 42 29 00" &
Chr(10) & "&10Fax:04 68 41 37 27"
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(2.38)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
End With

DoEvents
Application.ScreenUpdating = True
ActiveSheet.PrintPreview
'ActiveSheet.PrintOut
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.Calculation = inCalculationMode
End Sub
Avatar
Mgr T. Plubanni
ouf....j'ai eu peur pour michel
vous vous rendez compte : s'il s'était agi d'un surplus américain....
Mgr T. P.

"MichD" a écrit dans le message de news: ilnv2o$r2m$

Ça, c'est du chinois pour moi.
Avatar
MichD
Je crois deviner que Mgr T. Plubanni est surtout versé dans les surplis !

;-))



MichD
--------------------------------------------
"Mgr T. Plubanni" a écrit dans le message de groupe de discussion : 4d7f9531$0$32460$

ouf....j'ai eu peur pour michel
vous vous rendez compte : s'il s'était agi d'un surplus américain....
Mgr T. P.

"MichD" a écrit dans le message de news: ilnv2o$r2m$

Ça, c'est du chinois pour moi.
Avatar
Mgr T. Plubanni
:-))))))))))))))))))))))
votre remarque m'a surplis, mon fils
allez en paix nonobstant
T. P.

"MichD" a écrit dans le message de news:
ilo65i$d5f$
Je crois deviner que Mgr T. Plubanni est surtout versé dans les surplis !

;-))



MichD
--------------------------------------------
"Mgr T. Plubanni" a écrit dans le message de groupe de discussion :
4d7f9531$0$32460$

ouf....j'ai eu peur pour michel
vous vous rendez compte : s'il s'était agi d'un surplus américain....
Mgr T. P.

"MichD" a écrit dans le message de news:
ilnv2o$r2m$

Ça, c'est du chinois pour moi.



Avatar
surplus
MichD a écrit le 15/03/2011 à 18h03 :
Je crois deviner que Mgr T. Plubanni est surtout versé dans les surplis
!

;-))



MichD
--------------------------------------------
"Mgr T. Plubanni" a écrit dans le message de groupe de
discussion : 4d7f9531$0$32460$

ouf....j'ai eu peur pour michel
vous vous rendez compte : s'il s'était agi d'un surplus
américain....
Mgr T. P.

"MichD" a écrit dans le message
de news: ilnv2o$r2m$

Ça, c'est du chinois pour moi.




je sais pas j ai fait un copier coller de ma macro