• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

fout in code voor optellen textboxen

Status
Niet open voor verdere reacties.

bowlingman

Gebruiker
Lid geworden
17 okt 2007
Berichten
433
Hallo,
Ik heb een testje gemaakt om textboxen op te tellen.
Als ik op het form in de txt's van serie 1 onder de games een getal invoer, krijg ik onder totaal het ingevoerde getal maal 206
Als ik dit in de serie 2 doe krijg ik een foutmelding in de klassemodule

Grtjs.
Armand
 

Bijlagen

  • Test Optellen.xlsm
    25,2 KB · Weergaven: 50
Je zoekt naar een Textbox met de naam "TextBox12" (samenstelling van je variabelen), en die ken je helemaal niet op je formulier. Niet gek dat dat knalt....
 
Je tag-nummer is te hoog.

Code:
frmScores("Textbox" & Tt + 1)

tt = 11
tt+1 = 12
Je hebt maar 10 textboxen waarvan je er 8 van wilt beschrijven.
 
Ik heb de code als volgt veranderd
Code:
Private Sub TxtBx_Change()
Dim ctl As Control
Tt = TxtBx.Tag
tel = 0
Select Case TxtBx.Tag
    Case 3, [COLOR="#FF0000"]8[/COLOR]
        For Each ctl In frmScores.Controls
          If TypeName(ctl) = "TextBox" And ctl <> "" Then
             If CLng(ctl.Tag) + 3 = Tt + 3 Then tel = tel + ctl.Value
          End If
        Next ctl
      frmScores("Textbox" & Tt + 1) = tel
    Case 2, 10
     If TxtBx = "" Then
        frmScores("Textbox" & Tt + 5) = ""
      Else
       frmScores("Textbox" & Tt + 5) = TxtBx * 2
     End If
    Case 6, 14
       frmScores("Textbox" & Tt + 2) = Val(frmScores("Textbox" & Tt)) + Val(frmScores("Textbox" & Tt + 1))
    Case 7, 15
       frmScores("Textbox" & Tt + 1) = Val(frmScores("Textbox" & Tt - 1)) + Val(frmScores("Textbox" & Tt))
 End Select
End Sub
Maar de optelling onder totaal klopt niet en serie 2 gebeurt er niets.
 
Da's het vervelende van bowlen; Heb je eindelijk alle kegels omver, komt de bal weer terug en even later de kegels ook weer:p:D
 
Laatst bewerkt:
Kan je ons vertellen wat eigenlijk de bedoeling is?

Rechtstreeks verwijzen naar frmScores is geen goed idee, ik zou het zo doen:

Klasse:
Code:
Option Explicit
Public WithEvents TxtBx As MSForms.TextBox
Private tel As Double
Private Tt As Long
Public fForm As frmScores

Private Sub TxtBx_Change()
    Dim ctl As Control
    Tt = TxtBx.Tag
    tel = 0
    Select Case TxtBx.Tag
    Case 3, 11
        For Each ctl In fForm.Controls
            If TypeName(ctl) = "TextBox" And ctl <> "" Then
                If CLng(ctl.Tag) + 3 = Tt + 3 Then tel = tel + ctl.Value
            End If
        Next ctl
        fForm.Controls("Textbox" & Tt + 1) = tel    '<--- Foutmelding "Kan het opgegeven object niet vienden"
    Case 2, 10
        If TxtBx = "" Then
            fForm.Controls("Textbox" & Tt + 5) = ""
        Else
            fForm.Controls("Textbox" & Tt + 5) = TxtBx * 2
        End If
    Case 6, 14
        fForm.Controls("Textbox" & Tt + 2) = Val(fForm.Controls("Textbox" & Tt)) + Val(fForm.Controls("Textbox" & Tt + 1))
    Case 7, 15
        fForm.Controls("Textbox" & Tt + 1) = Val(fForm.Controls("Textbox" & Tt - 1)) + Val(fForm.Controls("Textbox" & Tt))
    End Select
End Sub
form:
Code:
Option Explicit
'Nooit "As New ..." gebruiken!
Private TextBoxes() As Klasse1


Private Sub UserForm_Initialize()
    Dim TxtCount As Integer, ctl As Control
    For Each ctl In Me.Controls
        If TypeName(ctl) = "TextBox" Then
            TxtCount = TxtCount + 1
            ReDim Preserve TextBoxes(1 To TxtCount)
            Set TextBoxes(TxtCount) = New Klasse1
            Set TextBoxes(TxtCount).TxtBx = ctl
            Set TextBoxes(TxtCount).fForm = Me
        End If
    Next ctl
End Sub
frmScores is OOK een klasse en hoort geinstantieert te worden
Code:
Private Sub CommandButton1_Click()
    Dim fScores As frmScores
    Set fScores = New frmScores
    fScores.Show
    Unload fScores
    Set fScores = Nothing
End Sub
 
Het plaatsen van de totaaltelling in jouw tekstbox triggert weer een nieuw TxtBx_Change event en weer en weer en weer .....
Hou die tekstboxen dus buiten jouw klasse (of gebruik een label, je wilt immers niet dat er in het totaalvak handmatig wat wordt geplaatst.
 
Het is eindelijk gelukt dank zij jullie helpers
Bedankt iedereen hiervoor
@ Harry
Ik had al geprobeert om de code die ik in van U heb gekregen in de vorige vraag aan te passen en dat lukte vooreerst niet.
Nu lang proberen en testen is het dan toch gelukt.
Ik wou nu wel nog proberen om zoals EVR voorstelt om de txt's onder totaal te veranderen in labels en dat daarin dan de totalen van de games komen te staan.
Helaas weet ik niet hoe ik dan de codes moet aanpassen.
Klassemodule nu
Code:
Option Explicit
Public WithEvents TxtBx As MSForms.TextBox
Private tel As Double
Private Tt As Long

Private Sub TxtBx_Change()
Dim ctl As Control
Tt = TxtBx.Tag
tel = 0
Select Case TxtBx.Tag
    Case 1, 5, 9
        For Each ctl In frmScores.Controls
          If TypeName(ctl) = "TextBox" And ctl <> "" Then
             If CLng(ctl.Tag) + 3 = Tt + 3 Then tel = tel + ctl.Value
          End If
        Next ctl
      frmScores("Textbox" & Tt + 3) = tel
 End Select
End Sub
En code in frm
Code:
Option Explicit
Private TextBoxes() As New Klasse1

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
    Dim TxtCount As Integer, ctl As Control
    For Each ctl In frmScores.Controls
        If TypeName(ctl) = "TextBox" Then
            TxtCount = TxtCount + 1
            ReDim Preserve TextBoxes(1 To TxtCount)
            Set TextBoxes(TxtCount).TxtBx = ctl
        End If
    Next ctl
End Sub

Grtjs.
Armand
 

Bijlagen

  • Test Optellen_4.xlsm
    27,4 KB · Weergaven: 37
Jan Karel,
Dit werkt niet correct.
Er komen geen totalen in de labels te staan en wanneer ik onder Game 1 bv "1" invul komt er automatisch onder Game 2 "206" te staan
Ik heb de file met op het frm 3 labels bijgevoegd.
 

Bijlagen

  • Test Optellen_5.xlsm
    28 KB · Weergaven: 32
Met een kleine wijziging in de code van de klasse en het hernoemen van de labels die de totalen moeten bevatten...
 

Bijlagen

  • Test Optellen_5 JKP.xlsm
    30 KB · Weergaven: 41
Ik zou het zo doen:

In het userform:
Code:
Dim sn() As New Klasse1

Private Sub UserForm_Initialize()
    ReDim sn(Controls.Count)
    
    For Each it In Controls
        If TypeName(it) = "TextBox" Then Set sn(it.TabIndex).v_text = it
    Next
End Sub

In de Klasse:
Code:
Public WithEvents v_text As MSForms.TextBox

Private Sub v_text_Change()
    With v_text.Parent
       Select Case Right(v_text.Name, 1)
       Case 1, 2, 3
          .L_01.Caption = Val(.T_01) + Val(.T_02) + Val(.T_03)
       Case 4, 5, 6
          .L_02.Caption = Val(.T_04) + Val(.T_05) + Val(.T_06)
       Case 7, 8, 9
          .L_03.Caption = Val(.T_07) + Val(.T_08) + Val(.T_09)
       End Select
    End With
End Sub
 

Bijlagen

  • __ballentent snb.xlsb
    23,5 KB · Weergaven: 35
Laatst bewerkt:
Hallo helpers,
Ik heb mijn progje aangepast met lbl's.
Optellen lukt nu perfect, alleen als ik onder "Speeldag" op de cbo klik, wordt deze niet meer gevuld en daardoor worden de lbl's onder datum en Team niet gevuld.

Iemand een idee wat ik nog verkeerd doe of vergeten ben.
(De volgorde van de txt's en het wegschrijven moet ik nog aanpassen)

Grtjs.
Armand
 

Bijlagen

  • Test Apero.xlsm
    43,5 KB · Weergaven: 40
Als je Option Explicit gebruikt dan moet je alle variabelen declareren. Geeft de melding ook aan.
 
In de eerste plaats super bedankt aan al de helpers.
Alles werkt nu perfect.
@VenA
Inderdaad was ik vergeten en is nu ook opgelost.

Grtjs.
Armand
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan