macro pas imprimer si vide

Le
surplus Hors ligne
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #23202141
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
MichD
Le #23202131
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
surplus Hors ligne
Le #23202481
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
surplus Hors ligne
Le #23204631
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
MichD
Le #23206681
| 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
Mgr T. Plubanni
Le #23206941
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, c'est du chinois pour moi.
MichD
Le #23207031
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, c'est du chinois pour moi.
surplus Hors ligne
Le #23207421
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
Mgr T. Plubanni
Le #23207511
:-))))))))))))))))))))))
votre remarque m'a surplis, mon fils
allez en paix nonobstant
T. P.

"MichD" 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" ilnv2o$r2m$

Ça, c'est du chinois pour moi.



Publicité
Poster une réponse
Anonyme