vba

[pierre]

bjr tout le monde,
Je suis coincé sur une macro pour masquer les lignes dont la valeur est nulle, merci d'avance de votre aide

 

[Gérard DEZAMIS]

Bonjour tout seul

Bonsoir Pierre

essayer ce code
Sub Cacher()
Dim derlgn As Integer
Dim cel As Range
Application.ScreenUpdating = False
With Worksheets('Feuil1')
derlgn = .Range('A65536').End(xlUp).Row
For Each cel In .Range('A1:A' & derlgn)
If cel.Value = '' Then
.Rows(cel.Row).EntireRow.Hidden = True
End If
Next
End With
Application.ScreenUpdating = True
End Sub
A mettre dans un bouton. Il te permettra de cacher les lignes vides de la colonne A. Tu dis 'valeur est nulle' est-ce que c'est une valeur = à zéro ? dans ce cas remplacer
If cel.Value = '' Then
par If cel.Value = 0 Then

@+GD

 

[hasnaa1192]

Re : vba

Bonjour
je suis moi aussi coincée là dessus alors un grand merci pour votre aide ........

en effet , moi je veut masquer les lignes pourlesquelles toutes les colonnes sont nulles et pas slmt la colonne A

c'est vrmt urgent pour moi

Merci

 

[mutzik]

Re : vba

bonjour,

il faudrait préciser à quoi correspond 'les colonnes sont nulles'

 

[Spitnolan08]

Re : vba

Bonjour à tous,
Deux solutions :

Sub Cacheligne()
'***Suppose que les valeurs des cellules sont numériques
    With ActiveSheet
        NC = Application.Columns.Count
        'DerL = .Range("A" & Application.Rows.Count).End(xlUp).Row [B];)Mutzik[/B]
        DerL = Selection.SpecialCells(xlCellTypeLastCell).Row
        DerC = Selection.SpecialCells(xlCellTypeLastCell).Column
        mult = 1
        For i = 1 To DerL
            For j = 1 To DerC
                mult = mult * Cells(i, j)
            Next
            If mult = 0 Then .Rows(i).EntireRow.Hidden = True
        Next
    End With
End Sub

et universelle :

Sub Cacheligne2()
'***Fonctionne pour tous types de valeurs
Dim DerL As Integer, DerC As Integer, i As Integer, j As Integer
Dim NB As Integer
    With ActiveSheet
        DerL = Selection.SpecialCells(xlCellTypeLastCell).Row
        DerC = Selection.SpecialCells(xlCellTypeLastCell).Column

        For i = 1 To DerL
            NB = 0
            For j = 1 To DerC
                If Cells(i, j) <> 0 And Cells(i, j) <> "" Then Exit For
                NB = NB + 1
            Next
            If NB = DerC Then .Rows(i).EntireRow.Hidden = True
        Next
    End With
End Sub

Cordialement

 

[yusukens2]

Re : vba

Hooo je n'ai pas besoin de cette macro mais je trouve que la solution est très intéressante, merci.

 

[hasnaa1192]

Re : vba

Merci spitnolan
ton code il marche bien , mais j ai un graphique dans les premieres lignes dela feuille , je veut pas que le graphique soit aussi masqué, comment faire alors???
merci

 

[yusukens2]

Re : vba

Y'a t'il peut etre une modification pour pouvoir masquer les lignes vides selon une sélection et non sur toute la feuille, cest peut etre une idée.

 

[Spitnolan08]

Re : vba

Re,

mais j ai un graphique dans les premieres lignes dela feuille , je veut pas que le graphique soit aussi masqué,

De l'intérêt de correctement poser les problèmes... Car on n'a pas de boule de cristal...

Il faut savoir si tu as un seul graphique ou plusieurs, s'ils ont toujours la même taille, si....

Un fichier exemple présentant les différentes configurations possibles serait plus parlant.

Si la plage occupée par ton graphique est toujours identique utilises l'idée de yusukens2.
Cordialement

 

[Spitnolan08]

Re : vba

Re,
En attendant ta réponse une solution un peu laborieuse qui traite le cas d'un seul graphique situé en haut de page :

Sub Cacheligne3()
'***Fonctionne pour tous types de valeurs avec présence d'un graphique en haut de page
Dim DerL As Integer, DerC As Integer, i As Integer, j As Integer
Dim NB As Integer, NBlig As Byte, Htotcel As Double
    With ActiveSheet
        DerL = Selection.SpecialCells(xlCellTypeLastCell).Row
        DerC = Selection.SpecialCells(xlCellTypeLastCell).Column
        Htotcel = 0
        NBlig = 0
        '***Définition de la première ligne de valeurs
        For i = 1 To DerL
            If Htotcel < .ChartObjects(1).Height Then
                Htotcel = Htotcel + Cells(i, 1).RowHeight
                NBlig = NBlig + 1
            Else
                Exit For
            End If
        Next
        '***Tri des lignes vides
        PremL = NBlig + 1
        For i = PremL To DerL
            NB = 0
            For j = 1 To DerC
                If Cells(i, j) <> 0 And Cells(i, j) <> "" Then Exit For
                NB = NB + 1
            Next
            If NB = DerC Then .Rows(i).EntireRow.Hidden = True
        Next
    End With
End Sub

Cordialement

 

[Spitnolan08]

Re : vba

Re,
Une petite dernière pour la route qui pourrait être allégée et accélérée... Pour traiter le cas d'un graphique seul situé en milieu de page.

Sub Cacheligne5()
'***Fonctionne pour tous types de valeurs avec présence d'un seul graphique à divers emplacements sur la feuille
Dim DerL As Integer, DerC As Integer, i As Integer, j As Integer
Dim NB As Integer, NBlig As Byte, Htotcel As Double, Hmax As Double
    With ActiveSheet
        DerL = Selection.SpecialCells(xlCellTypeLastCell).Row
        DerC = Selection.SpecialCells(xlCellTypeLastCell).Column

        HGraph = .ChartObjects(1).Top
        BGraph = .ChartObjects(1).Top + .ChartObjects(1).Height

        '***Définition de la première ligne de graphe
        Htotcel = 0
        NBlig = 0
        For i = 1 To DerL
            If Htotcel < HGraph Then
                Htotcel = Htotcel + Cells(i, 1).RowHeight
                lig1 = lig1 + 1
            Else
                Exit For
            End If
        Next
        
        '***Définition de la dernière ligne de graphe
        Htotcel = 0
        NBlig = 0
        For i = 1 To DerL
            If Htotcel < BGraph Then
                Htotcel = Htotcel + Cells(i, 1).RowHeight
                lig2 = lig2 + 1
            Else
                Exit For
            End If
        Next

        '***Tri des lignes vides
        For i = 1 To DerL
            If i > lig1 And i < lig2 + 1 Then GoTo 1
            NB = 0
            For j = 1 To DerC
                If Cells(i, j) <> 0 And Cells(i, j) <> "" Then Exit For
                NB = NB + 1
            Next
            If NB = DerC Then .Rows(i).EntireRow.Hidden = True
1       Next
    End With
End Sub

Cordialement