VBA - bordures tableau

Question

Pour le travail il faut que je mette en place un fichier planning, pour des interventions. Je dois me baser sur le fichier qui est utilisé actuellement. Les journées des techniciens sont découpées en demi-journée. Il y a donc deux lignes par techniciens. Afin d'avoir une trame qui ne bouge pas (puisque plusieurs utilisateurs, qui utilise plus ou moins bien excel) je me demandais si à l'aide d'une macro, il serait possible de déterminer les bordures de mes cellules. Éventuellement avoir un bouton qui rétablirait les bordures "par défaut" du tableau. Je commence seulement avec les macros, et sur ce fichier j'ai énormément d'idées qui requiert des macros que j'ai du mal à mettre en place. En espérant que vous pourrez m'aider. Je vous joint un fichier avec les bordures que je souhaiterais. Évidemment il y a beaucoup plus de ligne et de colonne, le fichier est juste un exemple de ce que je voudrais...

Curulis · Answer

Salut Mad-AC,

quelque chose comme ça?

Pour remettre de l'ordre dans le bazar, à condition que la structure soit toujours identique, bien sûr, double-clique sur une des cellules-année... (2020).

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim rCel As Range
Dim iOK%, iRowC%, iRow1%, iRow2%, iCol%, sCol$, sAdr$
'
If Not Intersect(Target, Columns(3)) Is Nothing Then
    If Selection.Cells(1, 1).Value > 2000 Then
        Cancel = True
        Application.ScreenUpdating = False
        Cells.Borders.LineStyle = xlNone
        On Error Resume Next
        '
        Set rCel = UsedRange.Find(what:=Target, lookat:=xlWhole, searchdirection:=xlNext)
        iRowC = Range("B" & Rows.Count).End(xlUp).Row
        If Not rCel Is Nothing Then
            sAdr = rCel.Address
            Do
                iRow1 = rCel.Row
                iCol = Cells(rCel.Row + 1, Columns.Count).End(xlToLeft).Column
                sCol = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
                Set rCel = UsedRange.FindNext(rCel)
                If rCel.Address = sAdr Then iOK = 1
                iRow2 = IIf(iOK = 0, rCel.Row - 1, iRowC)
                Range("A" & iRow1 & ":" & sCol & iRow2).Borders.LineStyle = 1
                Union(Range("A" & iRow1).Resize(2, 2), Range("A" & iRow1 + 2), Range("C" & iRow1)).BorderAround Weight:=xlMedium
                For x = 2 To 3
                    For y = iRow1 + 2 To iRow2 - 1 Step 2
                        Cells(y, x).Resize(2, 1).BorderAround Weight:=xlMedium
                    Next
                Next
                For x = 4 To iCol - 4 Step 5
                    Cells(iRow1, x).Resize(1, 5).BorderAround Weight:=xlMedium
                    Cells(iRow1 + 1, x).Resize(1, 5).BorderAround Weight:=xlMedium
                    For y = iRow1 + 2 To iRow2 - 1 Step 2
                        Cells(y, x).Resize(2, 5).BorderAround Weight:=xlMedium
                    Next
                Next
            Loop While Not rCel Is Nothing And iOK = 0
        End If
        '
        On Error GoTo 0
        Application.ScreenUpdating = True
    End If
End If
'
End Sub

A+

48bordersplanning.xlsm (25.00 Ko)

Curulis · Answer

Salut Mad-AC,

oui, forcément, je nettoie avant reconstruction...

Cells.Borders.LineStyle = xlNone

Si tu veux du cousu-main, faudrait peut-être songer à donner un fichier représentatif de la réalité!

Non?

A+