VBA Code werkt niet helemaal

Status
Niet open voor verdere reacties.
A

allard1977

Gebruiker
Lid geworden
7 feb 2011
Berichten
215
Ik heb een code achter een combo box. dit werk naar behoren tot dat ik vraag wat (ElseIf Forms.FormClassEnteryConf.Altered = True And Forms.FormClassEnteryConf.BOBCH = False Then) in het rood staat, het lijkt er op dat hij dat niet meer kan lezen? Heb alles al op verschillende posities gehad maar kom er niet uit. wie zou me kunnen helpen om ook het laatste stukje te kunnen laten werken.

de check boxen altered en BOBCH zijn gelocked. deze worden ergens ander aan gezet.



Code: 
Private Sub Date_AfterUpdate()

Dim age As Long
Dim Color As Long
Dim AgeMax1 As Long
Dim AgeMax2 As Long
Dim AgeMax3 As Long
Dim AgeMax4 As Long
Dim AgeMax5 As Long
Dim AgeMax6 As Long
Dim AgeMax7 As Long
Dim Kleur1 As Long
Dim Kleur2 As Long
Dim Kleur3 As Long
Dim Kleur4 As Long


age = CLng(Forms.FormClassEnteryConf.age_txt.Value)
Color = CLng(Forms.FormClassEnteryConf.Kleurtje.Value)
AgeMax1 = CLng("60")
AgeMax2 = CLng("122")
AgeMax3 = CLng("182")
AgeMax4 = CLng("274")
AgeMax5 = CLng("365")
AgeMax6 = CLng("465")
AgeMax7 = CLng("548")
Kleur1 = CLng("0")
Kleur2 = CLng("4")
Kleur3 = CLng("8")
Kleur4 = CLng("12")

If age > AgeMax2 Then  '2-4maand
         Me.KlasID_txt = "1"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)

If age > AgeMax2 Then '4-6maand
        Me.KlasID_txt = "2"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
            
If Forms.FormClassEnteryConf.Altered = True And Forms.FormClassEnteryConf.BOBCH = True Then 'BOBA
        Me.KlasID_txt = "16"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
ElseIf Forms.FormClassEnteryConf.Altered = False And Forms.FormClassEnteryConf.BOBCH = True Then 'BOBI
        Me.KlasID_txt = "28"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
ElseIf Forms.FormClassEnteryConf.Altered = False And Forms.FormClassEnteryConf.BOBCH = False Then
    If age > AgeMax3 Then '6-9maandI
         Me.KlasID_txt = "17"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)

    If age > AgeMax4 Then '9-12maandI
          Me.KlasID_txt = "18"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)

    If age > AgeMax5 Then '12-15maandI
        Me.KlasID_txt = "19"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)

    If age > AgeMax6 Then '15-18maandI
        Me.KlasID_txt = "20"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)

    If age > AgeMax7 And Color > Kleur1 Then 'blackI
        Me.KlasID_txt = "26"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
    If age > AgeMax7 And Color > Kleur2 Then  'blue merleI
        Me.KlasID_txt = "24"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
    If age > AgeMax7 And Color > Kleur3 Then 'RedI
        Me.KlasID_txt = "27"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
    If age > AgeMax7 And Color > Kleur4 Then 'red merleI
        Me.KlasID_txt = "25"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
    
            
[COLOR="#FF0000"]ElseIf Forms.FormClassEnteryConf.Altered = True And Forms.FormClassEnteryConf.BOBCH = False Then
[/COLOR]    If age > AgeMax3 Then '6-9maandI
         Me.KlasID_txt = "5"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)

    If age > AgeMax4 Then '9-12maandI
          Me.KlasID_txt = "6"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)

    If age > AgeMax5 Then '12-15maandI
        Me.KlasID_txt = "7"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)

    If age > AgeMax6 Then '15-18maandI
        Me.KlasID_txt = "8"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)

    If age > AgeMax7 And Color > Kleur1 Then 'blackI
        Me.KlasID_txt = "14"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
    If age > AgeMax7 And Color > Kleur2 Then  'blue merleI
        Me.KlasID_txt = "12"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
    If age > AgeMax7 And Color > Kleur3 Then 'RedI
        Me.KlasID_txt = "15"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
    If age > AgeMax7 And Color > Kleur4 Then 'red merleI
        Me.KlasID_txt = "13"
            Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
            Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

End Sub
 
Eerst maar een 'complimentje': dit is met afstand de meest onleesbare code die ik dit jaar op HelpMij (m.b.t. Access althans) gezien heb :). Dat kost wel even tijd om uit te pluizen, maar dat het makkelijker en simpeler kan (nee: moet) zal duidelijk zijn. Ik koop een paar extra hartversterkertjes, en ga aan de slag :).
 
Ik heb een poging gedaan om je 'stroomschema' een beetje te fatsoeneren, zodat je beter kunt zien wat wanneer wordt gedaan. En volgens mij klopt daar niet zoveel van.
schema.png
Alle vergelijkingen vanaf If Age > AgeMax3 worden alleen maar gedaan als de voorwaarden
Code: 
ElseIf frm.Altered = False And frm.BOBCH = False Then
waar zijn. En dat lijkt mij nogal onlogisch.
 
Laatst bewerkt:
Hallo OctaFish,
Dat krijg je he van die hobbisten die denken dat ze iets kunnen. Blijk baar nog niet.
Maar uw bijlage kan ik niet openen.
 
Het was een plaatje, dat ik naderhand een keer vervangen heb. Gaat blijkbaar niet geweldig :). Hij staat er nu (hoop ik) goed bij.
Ik heb ondertussen je code 'vertaald' zoals ik hem nu lees. En dan zul je zien dat hij erg vreemd loopt.
Code: 
Dim Age As Long, Color As Long, iChck As Byte
Dim frm As Form
Dim AgeMax() As Variant
Dim Kleur() As Variant

    AgeMax = Array(60, 122, 182, 274, 365, 465, 548)
    Kleur = Array(0, 4, 8, 12)
    
    Set frm = Forms.FormClassEnteryConf.Form
    iChk = Abs(frm.Altered) + (Abs(frm.BOBCH) * 2)
    
    Select Case Age
        Case Is > AgeMax(1)
            Me.KlasID_txt = "1"
        Case Is > AgeMax(2)
            
            Select Case iChk
                Case 0
                Case 1
                Case 2
                    Me.KlasID_txt = "28"
                Case 3
                    Me.KlasID_txt = "16"
            End Select
        Case Is > AgeMax(3)
            If iChk = 0 Then Me.KlasID_txt = "17"
            If iChk = 1 Then Me.KlasID_txt = "5"
        Case Is > AgeMax(4)
            If iChk = 0 Then Me.KlasID_txt = "18"
            If iChk = 1 Then Me.KlasID_txt = "6"
        Case Is > AgeMax(5)
            If iChk = 0 Then Me.KlasID_txt = "19"
            If iChk = 1 Then Me.KlasID_txt = "7"
        Case Is > AgeMax(6)
            If iChk = 0 Then Me.KlasID_txt = "20"
            If iChk = 1 Then Me.KlasID_txt = "8"
        Case Is > AgeMax(7)
            Select Case Color
                Case Is > Kleur(1)
                    If iChk = 1 Then Me.KlasID_txt = "14" Else: Me.KlasID_txt = "26"
                Case Is > Kleur(2)
                    If iChk = 1 Then Me.KlasID_txt = "12" Else: Me.KlasID_txt = "24"
                Case Is > Kleur(3)
                    If iChk = 1 Then Me.KlasID_txt = "15" Else: Me.KlasID_txt = "27"
                Case Is > Kleur(4)
                If iChk = 1 Then Me.KlasID_txt = "15" Else: Me.KlasID_txt = "25"
            End Select
    End Select
    Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
    Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
 
alvast heel erg bedankt voor de hulp

oke dit is inderdaad heel iets anders zeker begrijpelijker dan eerst.

Maar nu werkt het natuurlijk niet met knippen en plakken. en aangezien ik niet bekent ben met de case heb ik wat ondersteuning nodig.
De combo box waar dit in opgeroepen wordt staat in een subformulier.
de Age en de color komen van het hoofd formulier moeten we hier geen verwijzing naar maken?
de check boxen staan ook op het hoofd formulier.
volgens mij moet er naar >agemax2 me.klasid_txt = "2" komen te staan, klopt dit.
 
Ik heb jouw variant inmiddels ook 'opgeschoond', en dan ziet hij er zo uit:
Code: 
    If Age > AgeMax1 Then  '2-4maand
        Me.KlasID_txt = "1"
    ElseIf Age > AgeMax2 Then '4-6maand
        If frm.Altered = True And frm.BOBCH = True Then 'BOBA
            Me.KlasID_txt = "16"
        ElseIf frm.Altered = False And frm.BOBCH = True Then 'BOBI
            Me.KlasID_txt = "28"
        ElseIf frm.Altered = False And frm.BOBCH = False Then
            If Age > AgeMax3 Then '6-9maandI
                Me.KlasID_txt = "17"
            ElseIf Age > AgeMax4 Then '9-12maandI
                Me.KlasID_txt = "18"
            ElseIf Age > AgeMax5 Then '12-15maandI
                Me.KlasID_txt = "19"
            If Age > AgeMax6 Then '15-18maandI
                Me.KlasID_txt = "20"
            ElseIf Age > AgeMax7 Then
                If Color > Kleur1 Then 'blackI
                   Me.KlasID_txt = "26"
                ElseIf Color > Kleur2 Then  'blue merleI
                    Me.KlasID_txt = "24"
                ElseIf Color > Kleur3 Then 'RedI
                    Me.KlasID_txt = "27"
                ElseIf Color > Kleur4 Then 'red merleI
                    Me.KlasID_txt = "25"
                End If
            End If
        ElseIf frm.Altered = True And frm = False Then
            If Age > AgeMax3 Then '6-9maandI
                Me.KlasID_txt = "5"
            ElseIf Age > AgeMax4 Then '9-12maandI
                Me.KlasID_txt = "6"
            ElseIf Age > AgeMax5 Then '12-15maandI
                Me.KlasID_txt = "7"
            ElseIf Age > AgeMax6 Then '15-18maandI
                Me.KlasID_txt = "8"
            ElseIf Age > AgeMax7 Then
                If Color > Kleur1 Then 'blackI
                   Me.KlasID_txt = "14"
                ElseIf Color > Kleur2 Then  'blue merleI
                    Me.KlasID_txt = "12"
                ElseIf Color > Kleur3 Then 'RedI
                    Me.KlasID_txt = "15"
                ElseIf Color > Kleur4 Then 'red merleI
                   Me.KlasID_txt = "13"
                End If
            End If
        Else
            Me.KlasID_txt = "2"
        End If
    End If
Je had 2 loopjes naar AgeMax2; daarom heb ik de eerste omgezet naar AgeMax1. Neem aan dat je dat ook wel zelf zo wilt :)
Je kunt vanuit een hoofdformulier prima acties laten uitvoeren op een subformulier, mits de verwijzing klopt. Dat is bij jou niet zo het geval, maar ik neem aan dat je vanaf het subformulier werkt.
I.p.v. Color = CLng(Forms.FormClassEnteryConf.Kleurtje.Value) kun je dan dit gebruiken:
Code: 
Color = CLng(Me.Parent.Kleurtje.Value)
En dat werkt altijd, ongeacht de naam van het formulier. Zelf kies ik er voor om een Form object aan te maken, en die aan het (hoofd of sub, dat maakt dan niet zo uit) formulier te hangen. Dat doe je dus met:
Code: 
    Set frm = Forms.FormClassEnteryConf.Form
Daarna verwijs je overal dus naar frm. en ook dat houdt de code overzichtelijk.
Is dit beter leesbaar zo?
 
ik snap nog een ding niet helemaal.

Code: 
Select Case iChk
                Case 0
                Case 1
                Case 2
                    Me.KlasID_txt = "28"
                Case 3
                    Me.KlasID_txt = "16"
 
Laatst bewerkt:
Ik heb in een stap daarboven de twee selectievakjes uit je hoofdformulier bij elkaar opgeteld. Omdat een selectievakje de waarden 0 en -1 kent, heb ik de waarde met ABS positief gemaakt.
Code: 
    iChk = Abs(frm.Altered) + (Abs(frm.BOBCH) * 2)
Daarbij heb ik de tweede waarde met 2 vermenigvuldig, zijn er 4 verschillende uitkomsten mogelijk: 0 (beide uit; 0+0), 1, (eerste aan, tweede uit; 1+0), 2 (eerste uit, tweede aan; 0+2) en 3 (beide aan; 1+2). En de variabele wordt vervolgens in de Select Case gebruikt voor de vervolgstappen.
 
a oke dat is duidelijk.
maar krijg hem nu niet meer aan de praat.

ik heb de age nu age = frm.age_txt
en Color als Color=frm.kleurtje

maar hij doet helemaal niks met of zonder chck box aan.
dus wat doe ik fout

Code: 
Private Sub Date_AfterUpdate()

Dim age As Long, Color As Long, iChck As Byte
Dim frm As Form
Dim AgeMax() As Variant
Dim Kleur() As Variant

Set frm = Forms.FormClassEnteryConf.Form

    AgeMax = Array(60, 122, 182, 274, 365, 465, 548)
    Kleur = Array(0, 4, 8, 12)
    
    age = frm.age_txt
    Color = frm.Kleurtje
    
    iChk = Abs(frm.Altered) + (Abs(frm.BOBCH) * 2)
    
    Select Case age
        Case Is > AgeMax(1)
            Me.KlasID_txt = "1"
        Case Is > AgeMax(2)
            Me.KlasID_txt = "2"
            
            Select Case iChk
                Case 0
                Case 1
                Case 2
                    Me.KlasID_txt = "28"
                Case 3
                    Me.KlasID_txt = "16"
            End Select
        Case Is > AgeMax(3)
            If iChk = 0 Then Me.KlasID_txt = "17"
            If iChk = 1 Then Me.KlasID_txt = "5"
        Case Is > AgeMax(4)
            If iChk = 0 Then Me.KlasID_txt = "18"
            If iChk = 1 Then Me.KlasID_txt = "6"
        Case Is > AgeMax(5)
            If iChk = 0 Then Me.KlasID_txt = "19"
            If iChk = 1 Then Me.KlasID_txt = "7"
        Case Is > AgeMax(6)
            If iChk = 0 Then Me.KlasID_txt = "20"
            If iChk = 1 Then Me.KlasID_txt = "8"
        Case Is > AgeMax(7)
            Select Case Color
                Case Is > Kleur(1)
                    If iChk = 1 Then Me.KlasID_txt = "14" Else: Me.KlasID_txt = "26"
                Case Is > Kleur(2)
                    If iChk = 1 Then Me.KlasID_txt = "12" Else: Me.KlasID_txt = "24"
                Case Is > Kleur(3)
                    If iChk = 1 Then Me.KlasID_txt = "15" Else: Me.KlasID_txt = "27"
                Case Is > Kleur(4)
                If iChk = 1 Then Me.KlasID_txt = "15" Else: Me.KlasID_txt = "25"
            End Select
    End Select
    Me.Klasnaam_txt.Value = Me.KlasID_txt.Column(1)
    Me.Klasgroep_txt.Value = Me.KlasID_txt.Column(2)
End Sub
 
Je kan de laatste form eens weglaten.
Code: 
Set frm = Forms.FormClassEnteryConf
Ik heb je db niet, dus testen wordt lastig :). En probeer hem ook eens met Me.Parent. Wil ook nog wel eens werken.
 
hallo,

ik heb de code even uit gekleed om te kijken waar het probleem is.
Code: 
Private Sub Date_AfterUpdate()


Dim frm As from
Dim iChck As Byte


Set frm = Forms.FormClassEntery.Form
   
    iChk = Abs(frm.Altered) + (Abs(frm.BOBCH) * 2)
    
  Select Case iChk
                Case 0
                MsgBox "test1"
                Case 1
                MsgBox "test2"
                Case 2
                    MsgBox "test3"
                Case 3
                    MsgBox "test4"
  End Select
    
End Sub

hier krijg ik niks te zien. me.parent en de lange code ook al geprobeerd. dus mijn kennis stopt hier
de namen van de check boxen kloppen.

alvast heel erg bedankt
 
Dan word het tijd voor een voorbeeldje :).
 
Tja dat is een lastige vraag. Dit stukje maakt deel uit van een grotere database.
ik vind de programmering met de case mooier maar ben nog verder gaan puzzelen met de opgeruimde versie van mij die u gemaakt hebt.
Boven aan heb ik het oude stukje met de AS Long gezet. dit werkt nu perfect. Maar om het op te schonen wou ik het stukje variant gebruiken.
Dit wordt niet goed gelezen

dus ik heb.
dim kleur() as variant

Kleur = Array(0, 4, 8, 12)

en in de code:
If Color > Kleur(1)
Me.KlasID_txt = "26"

Color komt van de main form en is een getal.
waarom kan hij dit niet lezen.
 
Laatst bewerkt:
Vind het jammer dat er nu niet meer gereageerd wordt. Eerst al niet zo'n aardig antwoord sturen en nu gewoon niet reageren. Gelukkig zijn er andere groepen.
 
Nogmaals: ik heb je db niet, dus ik kan op dit moment niet veel anders doen dan op basis van wat jij aanlevert de code opschonen, en dat heb ik gedaan. Ik heb je om een voorbeeld db gevraagd, en die lever je niet aan.

allard1977 zei:
Eerst al niet zo'n aardig antwoord sturen en nu gewoon niet reageren. Gelukkig zijn er andere groepen.
Klik om te vergroten...
Aangezien ik de enige ben die op je vraag heeft gereageerd, neem ik maar aan dat je mijn antwoorden bedoelt.... Wel eens van een korreltje zout gehoord?

HelpMij is, net als de meeste forums, een forum dat werkt met vrijwilligers. Iedereen steekt er dus eigen tijd in, op momenten dat het de helper uitkomt. Je bent uiteraard vrij om je vraag op andere forums neer te leggen, al is het dan wel zo netjes om daar (en hier) te melden dat je de vraag op andere fora uit hebt staan. Crossposting zonder vermelding is een behoorlijk zware zonde in forumland, want je laat dan nietsvermoedende mensen hun vrije tijd steken in antwoorden die je al lang en breed op een ander forum hebt gehad; moet je niet willen!

Maak, als je nog steeds geholpen wilt worden, dus een voorbeeldje aan waar wat dummy data in zit, en alleen die tabellen en formulieren die je nodig hebt om de vraag op te kunnen lossen. We hoeven namelijk niet de hele db te hebben, of jouw echte records. Zolang de vraag maar gereproduceerd kan worden, is het ok.
 
Beste OctaFish,

Versta mij niet verkeerd, maar het was makkelijker als we er zonder voorbeeld data-base een oplossing konden vinden. Ik weet wat vrijwilligers werk is, ik ben ook maar voor de hobby een database gaan bouwen die de club kon gebruiken .

Ik wardeer het ook heel erg dat ik hier heel goed geholpen wordt dit is niet de eerste vraag en we komen er altijd uit mijn dank is groot.

Ik heb een voorbeeld database gemaakt.
https://www.dropbox.com/s/wg8w9at5u9r2zay/Database4.accdb?dl=0

Als je de datum invoert is de bedoeling dat AM/PM tevoorschijn komt (OK)
maar ook de Class en dit is afhankelijk van hoe oud het dier is en de kleur. maar ook als het een Altered is (Checkbox) en ook als de hond een champion is (Checkbox).

Achter datum staat nu een code van een mix omdat dit alleen werkt. ik zou graag de asvariant en frm gebruiken maar deze twee werken niet in mijn DB.

Alvast heel erg bedankt.
 
Laatst bewerkt:
Ik heb er even naar gekeken, maar ben nog niet heel ver gekomen; ik heb eerst de code omgewerkt naar de Select Case. Dan snap ik 'm tenminste :).
 
Beste Octafish,

De beste wensen voor 2017

heeft u het nog kunnen oplossen.

mvg
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan