Macro quadriallage

Le 17/06/2018 à 15:49

Bonjour

je voudrais une macro qui insére un quadriallage automatique a partir de B10 et detcte seul la derniere ligne .

14arcm-2015-caar-2.xlsm (31.66 Ko)
Le 17/06/2018 à 18:09

Bonjour,

À tester si ça convient...

Sub Bordures()
Dim DerLig As Integer

Application.ScreenUpdating = False

With Worksheets("CAAR")   'sur quelle feuille s'effectuera le traitement

    With .Range("B10:J65535")  'effacer les bordure '' dernière ligne à adapter au besoin
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With

    DerLig = .Cells(Rows.Count, "B").End(xlUp).Row  'Emmagasine le numéro de la dernière ligne utilisée

    With .Range("B10:J" & DerLig)  ' définie la plage
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With
End With
End Sub

ric

Le 18/06/2018 à 04:33

Salut abdernino, ric,

A coller dans le module de la feuille concernée.

La macro réagit aux changements dans les colonnes [B:J].

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.ScreenUpdating = False
'
If Not Intersect(Target, Range("B:J")) Is Nothing And Target.Row >= 10 Then
    iTRow = IIf(Target.Count = 1, Target.Row, Target.Row + Target.Rows.Count - 1)
    For x = 2 To 10
        iRow = IIf(Range(Chr(64 + x) & Rows.Count).End(xlUp).Row > iRow, Range(Chr(64 + x) & Rows.Count).End(xlUp).Row, iRow)
    Next
    If iTRow > iRow Then Range("B10:J" & iTRow).Borders.LineStyle = xlLineStyleNone
    Range("B" & IIf(iRow < 10, 9, 10) & ":J" & iRow).Borders.LineStyle = xlContinuous
End If
'
Application.ScreenUpdating = True
'
End Sub

A+

Le 18/06/2018 à 10:49

Bonjour tout le monde,

Salut curulis57

On pourrait aussi utiliser une simple MFC (Mise en Forme Conditionnelle)

Le 18/06/2018 à 12:12
curulis57 a écrit :

Salut abdernino, ric,

A coller dans le module de la feuille concernée.

La macro réagit aux changements dans les colonnes [B:J].

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.ScreenUpdating = False
'
If Not Intersect(Target, Range("B:J")) Is Nothing And Target.Row >= 10 Then
    iTRow = IIf(Target.Count = 1, Target.Row, Target.Row + Target.Rows.Count - 1)
    For x = 2 To 10
        iRow = IIf(Range(Chr(64 + x) & Rows.Count).End(xlUp).Row > iRow, Range(Chr(64 + x) & Rows.Count).End(xlUp).Row, iRow)
    Next
    If iTRow > iRow Then Range("B10:J" & iTRow).Borders.LineStyle = xlLineStyleNone
    Range("B" & IIf(iRow < 10, 9, 10) & ":J" & iRow).Borders.LineStyle = xlContinuous
End If
'
Application.ScreenUpdating = True
'
End Sub

A+

et si on rajouté directement selectionné la feuille caar

Le 18/06/2018 à 12:18

[quote=ric post_id=660552 time=1529251799 user_id=56402]

Bonjour,

À tester si ça convient...

Sub Bordures()
Dim DerLig As Integer

Application.ScreenUpdating = False

With Worksheets("CAAR")   'sur quelle feuille s'effectuera le traitement

    With .Range("B10:J65535")  'effacer les bordure '' dernière ligne à adapter au besoin
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With

    DerLig = .Cells(Rows.Count, "B").End(xlUp).Row  'Emmagasine le numéro de la dernière ligne utilisée

    With .Range("B10:J" & DerLig)  ' définie la plage
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With
End With
End Sub

Merci ça marche très bien, mais je voudrais que le quadrillage que sur les cellules qui ont des valeurs, pas les cellules qui on est des formules .pour moi elles sont considérés comme vides.

Le 18/06/2018 à 12:41

Bonjour,

Merci ça marche très bien, mais je voudrais que le quadrillage que sur les cellules qui ont des valeurs, pas les cellules qui on est des formules .pour moi elles sont considérés comme vides.

Quelles formules ?

Celles de la colonne A ?

ric

Le 18/06/2018 à 12:55

[quote=ric post_id=660723 time=1529318464 user_id=56402]

Bonjour,

Merci ça marche très bien, mais je voudrais que le quadrillage que sur les cellules qui ont des valeurs, pas les cellules qui on est des formules .pour moi elles sont considérés comme vides.

Quelles formules ?

Celles de la colonne A ?

le quadrillage avec cette macro va jusqu'à la dernière ligne, mais la dernière ligne contient des formules . moi je veux qu'elle s'arrête aux valeurs .

Le 19/06/2018 à 11:26

Bonjour ,

je veux que le quadriallge s'arrete a la derniere ligne ou il y uen valeur , pas les formule .

Le 19/06/2018 à 12:31

Salut,

je dis ça, je ne dis rien...

As-tu testé la macro que je t'ai envoyé ?

😈

A+

Le 19/06/2018 à 13:03

j'arrive pas a la rajouté a un bouton , pourquoi??

Le 19/06/2018 à 13:06

Salut,

c'est une procédure événementielle donc, automatique!

Tu la colles telle quelle dans le module de la feuille concernée (CAAR... ?) et tu te contentes ensuite d'apporter les changements dans tes données.

Le reste suivra...

A+

Le 19/06/2018 à 13:32

Soit...

11arcm-2015-caar-2.xlsm (30.35 Ko)
Rechercher des sujets similaires à "macro quadriallage"