VBA code

[ahkleine]

Ik hewb mbv vba een invulformulier gemaakt. In dit formulier moet de gebruiker allerlei getallen invoeren met 2 decimalen. Nadat alle velden gevuld zijn moet het totaalbedrag berekend worden. Mijn probleem is dat het invoervak een tekstvak is waardoor decimalen er niet toe doen. Wie weet h0e ik dat kan oplossen

 

[emields]

door (net als 10 jaar geleden) een voorbeeld bestandje te plaatsen.

 

[edmoor]

Het max. aantal in te geven tekens in een TextBox kan je eenvoudig beperken.
Ook kan je afdwingen dat er alleen cijfers en een komma ingegeven kunnen worden.
Verder: Zie #2.

 

[AHulpje]

Ach, voorbeeldje, kan wel zonder.

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    '0 t/m 9 = keyascii 49 t/m 57
    'komma   = 44
    'Eén komma toegestaan
    If KeyAscii = 44 Then
        If InStr(TextBox1, ",") = 0 Then Exit Sub
        KeyAscii = 0
    End If
    If (KeyAscii >= 49 And KeyAscii <= 57) Or KeyAscii = 44 Then
        Exit Sub
    End If
    KeyAscii = 0
End Sub

 

[edmoor]

En dan bij de berekening de TextBox1 waarde converteren naar Double met CDbl(TextBox1.Text).
Overigens kan het ook zo en zijn ook de 2 decimalen geregeld:

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
        Case 49 To 57
            If InStr(TextBox1.Text, ",") > 0 Then
                If Len(Split(TextBox1.Text, ",")(1)) > 1 Then KeyAscii = 0
            End If
        Case 44
            If InStr(TextBox1.Text, ",") > 0 Then KeyAscii = 0
        Case Else: KeyAscii = 0
    End Select
End Sub

 

[AHulpje]

Netjes!

 

[edmoor]

Dat zou je zeggen maar is niet zo.
Denk er maar eens over na

 

[AHulpje]

Was iets te snel met mijn reactie, had mijn bericht al aangepast, als er al twee cijfers na de komma staan...

 

[edmoor]

Nu TS nog

 

[emields]

Nu TS nog

Hij heeft niet de gewoonte nog van zich te laten horen. Net zo min als dat hij de gewoonte heeft een voorbeeldbestandje te plaatsen.

 

[JEC.]

Je voorkomt er echter nog niet mee dat men tekst kan kopiëren en plakken in de textbox

 

[edmoor]

Het is dan ook geen beveiliging
Je voorkomt ermee dat iemand per ongeluk iets verkeerds intikt.
Je kan uiteraard in de TextBox1_Exit een controle doen of de ingave correct is.
Als iemand bewust de boel wil vernaggelen zal dat altijd wel lukken.

 

[JEC.]

Je zou het ook in de textbox change kunnen afvangen

Dim reg

Private Sub TextBox1_Change()
If reg.test(TextBox1.Text) Then TextBox1.Text = reg.Replace(TextBox1.Text, "")
If UBound(Split(TextBox1.Text, ",")) > 1 Then TextBox1.Text = Left(TextBox1.Text, Len(TextBox1.Text) - 1)
End Sub

Private Sub UserForm_Initialize()
Set reg = CreateObject("vbscript.regexp")
reg.Pattern = "[^0-9,]"
End Sub

 

[edmoor]

Is ook netjes.
Nu de max. 2 decimalen nog.

 

[JEC.]

Oja die had ik niet gezien

Dim reg

Private Sub TextBox1_Change()
 Dim sp
 With TextBox1
    sp = Split(.Text, ",")
    If reg.test(.Text) Then .Text = reg.Replace(.Text, "")
    If UBound(sp) > 1 Then .Text = Left(.Text, Len(.Text) - 1)
    If UBound(sp) > 0 Then If Len(sp(1)) > 2 Then .Text = Left(.Text, Len(.Text) - 1)
 End With
End Sub

Private Sub UserForm_Initialize()
Set reg = CreateObject("vbscript.regexp")
reg.Pattern = "[^0-9,]"
End Sub

 

[ahkleine]

Hallo allemaal,

Heel erg bedankt voor alle oplossingen. Ik had uiteraard een voorbeeldbestandje toe moeten voegen, maar daar heb ik helemaal niet bij stil gestaan. Na heel veel mislukte pogingen en een aantal uren verder kwam ik er niet meer uit en heb de hulpvraag ingevoerd op de website van helpmij.nl Hiervoor mijn excuses. In ieder geval ga ik nu snel de aangeboden oplossingen snel uit proberen
Nogmaals bedankt,
Albert Kleine

 

[ahkleine]

Ik heb de oplossing uitgeprobeerd en het werkt wat mij alleen niet lukt om de ingevulde waardes opgeteld te kroijgen. Deze keer heb ik het voorbeeldbestand bijgevoegd

 

[AHulpje]

Zou zo kunnen:

Dim reg

Private Sub UserForm_Initialize()
    Set reg = CreateObject("vbscript.regexp")
    reg.Pattern = "[^0-9,]"
End Sub

Private Sub inv1_Change()
    inv1 = Controleer(inv1)
    result = TelOp
End Sub

Private Sub inv2_Change()
    inv2 = Controleer(inv2)
    result = TelOp
End Sub

Function Controleer(tekst) As String
    Dim sp
    sp = Split(tekst, ",")
    If reg.test(tekst) Then tekst = reg.Replace(tekst, "")
    If UBound(sp) > 1 Then tekst = Left(tekst, Len(tekst) - 1)
    If UBound(sp) > 0 Then If Len(sp(1)) > 2 Then tekst = Left(tekst, Len(tekst) - 1)
    Controleer = tekst
End Function

Function TelOp() As Double
    If Trim(inv1) <> "" Then TelOp = CDbl(inv1)
    If Trim(inv2) <> "" Then TelOp = TelOp + CDbl(inv2)
End Function

 

[edmoor]

Zoals in #5 al is vermeld dus.

 

[ahkleine]

Ahulpje,

Het werkt perfect, Heel erg bedankt

Albert Kleine