Ik ben met een bestand bezig waarbij ik op een werkblad wat testjes laat lopen zodat de input goed is.
Probleem met me script is dat als ik bijv een regel plak het script pas werkt op het moment dat ik de cel selecteer waarop de procedure betrekking heeft.
In het onderstaande mijn script, misschien pak ik het wel verkeerd aan, ik vind het script nu ook niet echt lekker lopen.
Probleem met me script is dat als ik bijv een regel plak het script pas werkt op het moment dat ik de cel selecteer waarop de procedure betrekking heeft.
In het onderstaande mijn script, misschien pak ik het wel verkeerd aan, ik vind het script nu ook niet echt lekker lopen.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
On Error Resume Next
If IsNull(Target) = False Then
Select Case Target.Column
Case Is = 4
If Target.Cells.Count > 0 Then
If Target.Row > 6 And Target.Row < 5000 Then
For intCounter = 1 To Target.Cells.Count
If Len(Target(intCounter, 1)) > 13 Then
Target(intCounter, 1).Interior.Color = vbRed
MsgBox "De waarde die u heeft in gevoerd in cel " _
& Target(intCounter, 1).Address & " is langer dan 13 karakters " _
& "(" & Len(Target(intCounter, 1)) & " karakters)." & vbNewLine _
& "De betreffende cel is gearceerd."
Else
Target(intCounter, 1).Interior.ColorIndex = xlNone
End If
Next
End If
End If
Case 18 To 20 Or 31
If Target.Cells.Count > 0 Then
If Target.Row > 6 And Target.Row < 5000 Then
For intCounter = 1 To Target.Cells.Count
If IsNull(Target(intCounter, 1)) = False Or Target(intCounter, 1) = "" Then
If IsDouble(Target(intCounter, 1)) = True And IsNull(Target(intCounter, 1)) = False Then
Target(intCounter, 1) = MyRound(Target(intCounter, 1))
MsgBox "De waarde die u heeft ingevuld in: " & Target(intCounter, 1).Address _
& " is afgekapt naar vier decimalen."
ElseIf Target(intCounter, 1) = "" Then
Target(intCounter, 1).Interior.ColorIndex = xlNone
Else
Target(intCounter, 1).Interior.Color = vbRed
MsgBox "De waarde die u heeft ingevuld in: " & Target(intCounter, 1).Address _
& " bevat letters." & vbNewLine & "De cel is gearceerd."
End If
Else
Target(intCounter, 1).Interior.Color = xlNone
End If
Next
End If
End If
End Select
Else
Exit Sub
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Function IsDouble(ByVal strValue As String) As Boolean
If Not strValue = vbNullString Then
On Error GoTo Hell
IsDouble = CDbl(strValue)
IsDouble = True
Exit Function
Else
Exit Function
IsDouble = False
End If
Hell:
IsDouble = False
End Function
Function MyRound(ByVal strValue As String) As Double
For bytCounter = 1 To Len(strValue)
If Mid(strValue, bytCounter, 1) = "," And Len(strValue) >= bytCounter + 4 Then
MyRound = Mid(strValue, 1, bytCounter + 4)
Exit Function
End If
Next
MyRound = CDbl(strValue)
End Function
Laatst bewerkt: