Excel VBA worksheet_change probleem

[dengeuns]

Hallo allemaal,

Ik ben sinds kort begonnen met te programmeren in VBA Excel en ik zou een vrij simpel programma willen maken. Om te beginnen is hierin de bedoeling om vanaf een bepaalde rij randen te plaatsen in mijn werkblad. Wanneer ik bijvoorbeeld in kolom A iets type zou rechts ervan een randje moeten komen. De programma code die ik hiervoor probeer te gebruiken is de volgende:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lRw As Long

    If Intersect(Target.Cells(1, 1), Range("A:M")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    With Range("L4")
        .Value = Now()
        .NumberFormat = "dd-mm-yyyy"
    End With
    
    If Intersect(Target, Columns(1)) Then
        lRw = Target.Row
        If lRw > 14 Then
            Cells(lRw, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
            If UCase(Target) = "" Then
                Cells(lRw, 1).Borders(xlEdgeRight).LineStyle = xlLineStyleNone
            End If
        End If
    End If
    
    If Intersect(Target, Columns(2)) Then
        lRw = Target.Row
        If lRw > 14 And Cells(lEmptyRow, 1).Value = "" Then
            Cells(lRw, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
            If UCase(Target) = "" Then
                Cells(lRw, 2).Borders(xlEdgeLeft).LineStyle = xlLineStyleNone
            End If
        End If
    End If
    
    Application.EnableEvents = True
    Exit Sub
    
End Sub

Het probleem is nu echter dat deze code niet werkt. Ik krijg geen foutmelding maar er gebeurt gewoon helemaal niets. Maak ik hier een extreem domme fout in de instellingen of klopt deze code gewoon niet.

Alvast bedankt!

 

[paulva]

Waarschijnlijk volstaat de volgende code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim intBepaaldeRij As Integer
    intBepaaldeRij = 18
    If Target.Column = 1 And Target.Row >= intBepaaldeRij Then
        Target.Borders(xlDiagonalDown).LineStyle = xlNone
        Target.Borders(xlDiagonalUp).LineStyle = xlNone
        Target.Borders(xlEdgeLeft).LineStyle = xlNone
        Target.Borders(xlEdgeTop).LineStyle = xlNone
        Target.Borders(xlEdgeBottom).LineStyle = xlNone
        With Target.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Target.Borders(xlInsideVertical).LineStyle = xlNone
        Target.Borders(xlInsideHorizontal).LineStyle = xlNone
    End If
End Sub

Dan moet je enkel nog de events tijdelijk uitschakelen (waarom eigenlijk?) en controle doen op de vorm van de selectie.

Beste groeten,
Paul.

 

[Warme bakkertje]

Of met een loop.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim intBepaaldeRij As Integer, b As Variant
    intBepaaldeRij = 18
    With Target
        If .Column = 1 And .Row >= intBepaaldeRij Then
            For Each b In Array(xlDiagonalDown, xlDiagonalUp, _
                xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, _
                xlInsideVertical, xlInsideHorizontal)
                .Borders(b).LineStyle = xlNone
            Next
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End If
    End With
End Sub

 

[Roncancio]

Iets korter.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then Target.Offset(0, 1).BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
End Sub

Met vriendelijke groet,


Roncancio

 

[dengeuns]

Bedankt allemaal, ik deed het precies wat moeilijk terwijl het makkelijk ook gaat. Die EnableEvents komt trouwens voort uit het deel voor de datum automatisch aan te passen. Hiervoor ben ik ook vertrokken van een stukje code dat ik gevonden had op het net.