workcheet change event

Status
Niet open voor verdere reacties.

Interface

Gebruiker
Lid geworden
27 jan 2009
Berichten
156
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.

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:
kun je even kort aangeven wat er nu daadwerkelijk gebeurd of moet gebeuren. Ik ben niet goed genoeg om snel te kunnen zien wat er gebeurd maar ik heb wel de indruk dat er iets omslachtigs gebeurd voor iets feitelijks heel simpels.
 
ok

Het script wat ik hier boven heb gegeven, moet er voor zorgen dat op het moment dat er een waarde wordt in gevuld die langer is dan 13 karakters in kolom 4(=kolom "D") en het regel nummer is groter dan 6 en kleiner als 5000 dan moet de cel rood worden. Voor de zelfde regel nummers maar dan in kolom 18 t/m 20 en kolom 31 moet de waarde afgekapt worden op vier decimalen( de waarde mag niet afgerond worden, maar echt afgekapt bij vier decimalen).

Dit doet het script ook wel maar niet als ik gegevens plak, ik moet dan apart een cel activeren(aan klikken) in het gebied van kolom 4 ,18 t/m 20 en 31. Ik wil dat het script ongeacht van de cel waar ik zit of het aantal gegevens wat ik in één keer plak de gegevens gelijk aangepast worden.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan