Algemene macro om tekstboxen te controleren op invoer

Status
Niet open voor verdere reacties.

MartijnC86

Gebruiker
Lid geworden
8 jul 2010
Berichten
13
Beste Forummers,

Ik zit even met een vraag. Ik ben namelijk voor mijn afstudeerproject bezig en ik zoek eigenlijk een handige manier om tekstboxen te controleren op hun waarde. Echter nu heb ik een flink aantal invoervelden (tekstboxen) die ik via een formulier laat invullen. Nu heb ik tot nu toe al mijn tekstboxen via de volgende code laten controleren op de invoerwaarde.

Code:
Private Sub txtjaar1_BeforeUpdate _
(ByVal Cancel As MSForms.ReturnBoolean)
    
    If Not IsDate(Me.txtjaar1) Then
    Cancel = True
    Beep
    MsgBox "De invoer is geen geldige datum, voer a.u.b. in volgens de dd-mm-jjjj methode."

  End If
End Sub

Mijn vraag:
Hoe kan ik nu een algemene code schrijven, zodat ik alleen in een tekstbox hoef te verwijzen naar een macro die de textbox controleert op haar invoer?
Dus bijvoorbeeld:

Code:
Private Sub TextBox269_Change()
CheckInvoerGetal
End Sub

Is dit mogelijk? Het zal mij namelijk erg veel tijd schelen als ik niet in elke tekstbox de code hoef te plakken en hoef aan te passen.

Met vriendelijke groet en alvast bedankt voor de hulp.

MartijnC86
 
kan dit je misschien helpen?

Als je de textboxen consistent naam en nummer toekent kun je misschien wat code laten genereren, die het je wat makkelijker maakt om snel alle textboxen van code te voorzien.

Code:
Private Sub CODE_generator()
Dim fso As Object
Dim wshshell As Object
Dim strdesktopdir As String
Dim aantal_text_boxen As Integer
Dim textbox_basis_naam As String
Dim i As Integer

aantal_text_boxen = 10              'aantal textboxen
textbox_basis_naam = "txtjaar"      'basisnaam van control, bijvoorbeeld "Textbox"

Set wshshell = CreateObject("Wscript.Shell")
strdesktopdir = wshshell.specialfolders("desktop") & "\"    'pak desktop map

'start het filesystemobject, en maak een textfile voor code output
Set fso = CreateObject("Scripting.filesystemobject")

With fso.CreateTextFile(strdesktopdir & "code.txt")
    
'hier wordt de code samengesteld, x keer dezelfde bewerking, maar dan met de juiste objectnaam + nummer
    For i = 1 To aantal_text_boxen
        
        .writeline "Private sub txtjaar" & i & "_BeforeUpdate(ByVal Cancel As MSForms.ReturnBolean)"
        .writeline "    If not isdate(Me." & textbox_basis_naam & i & ") Then"
        .writeline "        Cancel = True"
        .writeline "        Msgbox = ""De invoer is geen geldige datum, voer a.u.b. in volgens de dd-mm-jjjj methode."
        .writeline "    end if"
        .writeline "    end sub"
        
    Next
    
End With

Set fso = Nothing
'popup notepad met gegenereerde code
wshshell.Run "Notepad " & strdesktopdir & "code.txt"

Set fso = Nothing
Set wshshell = Nothing
End Sub

Je kunt overwegen om de check pas te doen als de gebruiker het userform verlaat.
Dan kun je wel met een routine door al je textboxen heen en dan pas checken of al je textboxen wel het juiste datatype hebben.
 
Je kunt met twee aparte functies controleren of een tekstveld een getal of een datum bevat.

Code:
Function CheckDatum(sVeld As String) As Boolean
Dim ctl As Control
    For Each ctl In Controls
        With ctl
           If ctl.Name = sVeld Then
                If Not IsDate(Me(sVeld)) Then CheckDatum = True
                Exit For
            End If
        End With
    Next ctl
End Function
Code:
Function CheckGetal(sVeld As String) As Boolean
Dim ctl As Control
    For Each ctl In Controls
        With ctl
            If ctl.Name = sVeld Then
                If Not IsNumeric(Me(sVeld)) Then CheckGetal = True
                Exit For
            End If
        End With
    Next ctl
End Function

Voor je Datumveld gebruik je hem als volgt (op de procedure <AfterUpdate>, niet <BeforeUpdate>. Je weet dan namelijk nog niet wat er wordt ingevoerd omdat het tekstvak leeg is (Before....)
Private Sub txtJaar1_AfterUpdate()
Code:
If CheckDatum(Me.txtjaar1) = True Then
    Cancel = True
    MsgBox "De invoer is geen geldige datum, voer a.u.b. in volgens de dd-mm-jjjj methode."
End If
End Sub
 
Laatst bewerkt:
Octafish,

bedankt alvast voor de hulp. Alleen kom ik er toch nog niet uit. Ik heb beide functies toegevoegd. Echter loopt de macro toch nog niet goed. Ik kan namelijk een naam invoeren waar ik alleen wil dat er tekst wordt ingevoerd.

Code:
'Functie om een tekstbox te controleren op een datum
Function CheckDatum(sVeld As String) As Boolean
Dim ctl As Control
    For Each ctl In Controls
        With ctl
           If ctl.Name = sVeld Then
                If Not IsDate(Me(sVeld)) Then CheckDatum = True
                Exit For
            End If
        End With
    Next ctl
End Function

Ik heb dan bij mijn tekstbox staan:

Code:
Private Sub txtendprognose_afterUpdate()
If CheckDatum(Me.txtendprognose) = True Then
    Cancel = True
    MsgBox "De invoer is geen geldige datum, voer a.u.b. in volgens de dd-mm-jjjj methode."
End If
End Sub

Echter hier kan ik dus alsnog van alles invoeren. Wat gaat er fout :(?
 
Dit volstaat in een standaardmodule
Code:
'Functie om een tekstbox te controleren op een datum
Function CheckDatum(sVeld As String) As Boolean
    If Not IsDate(sVeld) And sVeld <> vbNullString Then CheckDatum = True
End Function
En deze in je userformmodule
Code:
Private Sub txtendprognose_afterUpdate()
If CheckDatum(Me.txtendprognose) = True Then
    Cancel = True
    MsgBox "De invoer is geen geldige datum, voer a.u.b. in volgens de dd-mm-jjjj methode."
End If
End Sub
 
Warme Bakkertje,

ik heb de code toch nog iets aangepast. Bij jouw code kwam de foutmelding wel goed, maar excel liet wel de invoer staan. Dus stonden er alsnog ongewenste dingen in mijn formulier.

Als volgt opgelost:

Code:
Private Sub txtendprognose_BeforeUpdate _
(ByVal Cancel As MSForms.ReturnBoolean)
If CheckDatum(Me.txtendprognose) = True Then
    Cancel = True
    MsgBox "De invoer is geen geldige datum, voer a.u.b. in volgens de dd-mm-jjjj methode."
End If
End Sub

Nu werkt ie perfect!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan