XL 2016 VBA Problème avec les bordures intérieures

danielco

XLDnaute Accro
Bonjour,

J'ai un problème avec mon code. Les bordures intérieures verticales et horizontales ne se positionnent pas. J'ai essayé :

VB:
.Borders(xlInsideVertical).LineStyle = xlContinuous
ou
Code:
      With .Borders(xlInsideVertical)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlThin
      End With
Sans succès (pareil pour les bordures horizontales.

Voici le code (double clic sur la colonne D :

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim Ligne As Long, I As Long, C As Range
  If Target.Column = 4 Then
    'colonne D
    Application.EnableEvents = False
    Cancel = True
    Rows(Target.Offset(1).Row).Insert
    Set Target = Target.Resize(Target.Cells.Count + 1)
    Target.VerticalAlignment = xlVAlignCenter
    Target.Offset(, -1).Resize(Target.Cells.Count).Merge
    Target.Offset(, -1).VerticalAlignment = xlVAlignCenter
    Target.Offset(, -2).Resize(Target.Cells.Count).Merge
    Target.Offset(, -2).VerticalAlignment = xlVAlignCenter
    Target.Offset(, -3).Resize(Target.Cells.Count).Merge
    Target.Offset(, -3).VerticalAlignment = xlVAlignCenter
    With Range("A3:A" & ActiveSheet.UsedRange.Rows.Count)
      .Borders(xlEdgeLeft).LineStyle = xlContinuous
      .Borders(xlEdgeTop).LineStyle = xlContinuous
      .Borders(xlEdgeBottom).LineStyle = xlContinuous
      .Borders(xlEdgeRight).LineStyle = xlContinuous
'      .Borders(xlInsideVertical).LineStyle = xlContinuous
      With .Borders(xlInsideVertical)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlThin
      End With
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    For Each C In Range("E3:E" & ActiveSheet.UsedRange.Rows.Count)
      C = C.Row - 2
    Next C
    Application.EnableEvents = True
  ElseIf Target.Column = 2 And Not Intersect(Target, ActiveSheet.UsedRange) Is Nothing Then
    'colonne B
    Application.EnableEvents = False
    Cancel = True
    Rows(Target.Resize(1).Offset(, 2).Offset(1, -2).Row).Insert
'    Ligne = Cells(Rows.Count, 3).End(xlUp).Row
'    For Each c In Range("A3:A" & Ligne)
'      ctr = ctr + 1
'      c = ctr
'    Next c
    Application.EnableEvents = True
  End If
End Sub
Je suis sans doute passé à côté de quelque chose, mais quoi ?

Merci d'avance.

Daniel
 

Pièces jointes

  • test bordures.xlsm
    30.6 KB · Affichages: 14

Discussions similaires

Réponses
8
Affichages
620