tekstveld kleuren op subformulier ( .backcolor)

Status
Niet open voor verdere reacties.
S

Steven80

Gebruiker
Lid geworden
25 jun 2014
Berichten
8
Hallo,

Ik zit met volgende situatie:

Een formulier kalender, bestaande uit subformulieren waarvan het bronobject voor alle subforumieren een formulier is agenda.

Ik wil in mijn subformulieren de details kleuren afhankelijk van een waarde die ik uit een combobox haal.

Als ik enkel het subformulier open, werkt de code perfect. als ik echter het hoofdformulier open, kleurt er maar een gedeelte en niet alles.

Wie weet raad?

Hieronder wat afbeeldingen en code om alles te verduidelijken:

hoofdformulier:
form.jpg

subformulier:
subform.jpg

volgende code staat in het subformulier bij details_paint:

Code: 
Private Sub details_paint()
Dim ROOD As Long
Dim Groen As Long
Dim Geel As Long
Dim GRIJS As Long
Dim LBL As Long
Dim BL As Long
Dim DBL As Long
Dim SEP As Long
Dim PURP As Long
Dim TURQ As Long
Dim WIT As Long
Dim ZWART As Long

ZWART = RGB(0, 0, 0)
WIT = RGB(255, 255, 255)
ROOD = RGB(255, 127, 80)
Groen = RGB(0, 205, 0)
Geel = RGB(255, 215, 0)
LBL = RGB(99, 184, 255)
BL = RGB(202, 255, 255)
DBL = RGB(0, 0, 128)
SEP = RGB(0, 245, 255)
PURP = RGB(224, 102, 255)
TURQ = RGB(0, 238, 118)
GRIJS = RGB(205, 197, 191)


If Optie = True Then
    Me.Section(acDetail).Controls("txtnaam").BackColor = GRIJS
Else
    Select Case CatID
        Case 1
            Select Case SubCatID
                Case 1
                Me.Section(acDetail).Controls("txtnaam").BackColor = LBL
                Case 2
                Me.Section(acDetail).Controls("txtnaam").BackColor = BL
                Case 3
                Me.Section(acDetail).Controls("txtnaam").BackColor = LBL
                Case 4
                Me.Section(acDetail).Controls("txtnaam").BackColor = LBL
                Case 5
                Me.Section(acDetail).Controls("txtnaam").BackColor = LBL
                Case 6
                Me.Section(acDetail).Controls("txtnaam").BackColor = LBL
                Case Else
                Me.Section(acDetail).Controls("txtnaam").BackColor = LBL
            End Select
        Case 2
        Me.Section(acDetail).Controls("txtnaam").BackColor = ROOD
        Case 3
        Me.Section(acDetail).Controls("txtnaam").BackColor = Groen
        Case 4
        Me.Section(acDetail).Controls("txtnaam").BackColor = Geel
        Case Else
        Me.Section(acDetail).Controls("txtnaam").BackColor = WIT
    End Select
End If


End Sub
 
Nog een toevoeging: Als ik een 2de maal op vandaag klik, of een 2de maal dezelfde waarde kies in de combobox kleurt hij wel alles zoals het moet.
 
En waar wordt de waarde van de variabele Optie bepaalt?
 
Zonder de db erbij kan ik er weinig van zeggen. Zo verbaas ik mij dat je een gebeurtenis Details_Paint heb waar ik nooit van gehoord heb :). Daarnaast zie ik in je code wat overbodige (want identieke) regels die je dus kunt verwijderen.
Code: 
                Select Case SubCatID
                    Case 2
                        Me.Section(acDetail).Controls("txtnaam").BackColor = BL
                    Case Else
                        Me.Section(acDetail).Controls("txtnaam").BackColor = LBL
                End Select
doet namelijk volgens mij hetzelfde. Maar doe vooral de db erbij...
 
Goed gezien! Zelf zou ik een extra variabele gebruiken en dat stukje dan zo doen:
Code: 
    If Optie = True Then
        Kleur = GRIJS
    Else
        Select Case CatID
            Case 1
                Select Case SubCatID
                    Case 2:     Kleur = BL
                    Case Else:  Kleur = LBL
                End Select
            Case 2:             Kleur = ROOD
            Case 3:             Kleur = Groen
            Case 4:             Kleur = Geel
            Case Else:          Kleur = WIT
        End Select
    End If
    
    Me.Section(acDetail).Controls("txtnaam").BackColor = Kleur
 
Ik wacht liever op de db. De hele code kan anders en beter. Van mij mag je er tijd in steken, als je niks beters te doen hebt :)
 
Als het om Access gaat laat ik het sowieso liever aan jou over ;)
 
Lijkt mij een goed plan :D
 
De variabele optie is geen variabele maar een veld in de tabel tblEvents. Het subformulier haalt zijn gegevens uit deze tabel.

Ik heb met jullie tips (waarvoor dank) mijn code al een beetje opgeschoond, maar zonder resultaat.

Ik wil gerust de database ff doorsturen naar jullie, want krijg ze er hier niet bijgevoegd (te groot, ook als zip). laat me ff een berichtje en dan stuur ik ze per mail door als jullie willen.

Het vreemde blijf ik vinden dat als je vb februari kiest in de combobox er een deel 'gekleurd wordt' en een deel niet, maar als je het dan een 2de maal doet, kleurt hij alles zoals het zou moeten.

hier alvast ook de code zoals die in mijn formulier 'frmKalender staat'
Er zijn vast een aantal zaken die anders kunnen (ben maar een beginner met vba) Alle tips zijn welkom ;-)

dank
Steven

Code: 
Option Compare Database

Public AantalDagen As Integer
Public Zoekdatum As Date
Public LaatsteWeekdag As Integer


Private Sub cboJaar_AfterUpdate()
'filter instellen
Zoekdatum = 1 & "/" & Month(Zoekdatum) & "/" & cboJaar
AantalDagen = DateSerial(Year(Zoekdatum), Month(Zoekdatum) + 1, 1) - DateSerial(Year(Zoekdatum), Month(Zoekdatum), 1)
LaatsteWeekdag = AantalDagen + Weekday(Zoekdatum, 2)

'functies aanroepen om niet gebruikte subs te verbergen en leeg te maken
VerbergEerste
VerbergLaatste
Leegmaken

'Dag bij juiste sub zetten
For a = 1 To AantalDagen
Me.Controls("txt" & a + Weekday(Zoekdatum, 2) - 1).value = a
Next

'Zorgen dat het lichtblauw dat op vandaag stond terug zwart wordt
KleurNiets
'vandaag in het lichtblauw zetten
KleurVandaag
'gegevens invullen in de subforms
VulGegevens
End Sub

Private Sub cboMaand_AfterUpdate()
Zoekdatum = 1 & "/" & cboMaand & "/" & Year(Zoekdatum)
AantalDagen = DateSerial(Year(Zoekdatum), Month(Zoekdatum) + 1, 1) - DateSerial(Year(Zoekdatum), Month(Zoekdatum), 1)
LaatsteWeekdag = AantalDagen + Weekday(Zoekdatum, 2)


VerbergEerste
VerbergLaatste
Leegmaken
For a = 1 To AantalDagen
Me.Controls("txt" & a + Weekday(Zoekdatum, 2) - 1).value = a
Next
KleurNiets
KleurVandaag
VulGegevens
End Sub


Private Sub cboVandaag_Click()
cboJaar = Year(Date)
cboMaand = Month(Date)
Zoekdatum = 1 & "/" & Month(Date) & "/" & Year(Date)
AantalDagen = DateSerial(Year(Zoekdatum), Month(Zoekdatum) + 1, 1) - DateSerial(Year(Zoekdatum), Month(Zoekdatum), 1)
LaatsteWeekdag = AantalDagen + Weekday(Zoekdatum, 2)

VerbergEerste
VerbergLaatste
Leegmaken
For a = 1 To AantalDagen
Me.Controls("txt" & a + Weekday(Zoekdatum, 2) - 1).value = a
Next
KleurNiets
KleurVandaag
VulGegevens

End Sub




Private Sub form_load()
cboJaar = Year(Date)
cboMaand = Month(Date)
Zoekdatum = 1 & "/" & Month(Date) & "/" & Year(Date)
AantalDagen = DateSerial(Year(Zoekdatum), Month(Zoekdatum) + 1, 1) - DateSerial(Year(Zoekdatum), Month(Zoekdatum), 1)
LaatsteWeekdag = AantalDagen + Weekday(Zoekdatum, 2)

VerbergEerste
VerbergLaatste
Leegmaken
For a = 1 To AantalDagen
Me.Controls("txt" & a + Weekday(Zoekdatum, 2) - 1).value = a
Next
KleurNiets
KleurVandaag
VulGegevens

End Sub

Public Sub Leegmaken()
For a = 1 To 37
    Me.Controls("txt" & a).value = ""
Next a
End Sub

Public Sub VerbergEerste()

Select Case Weekday(Zoekdatum, 2)
    Case 1
        Form_frmKalender!Sub1.Visible = True
        Form_frmKalender!Sub2.Visible = True
        Form_frmKalender!Sub3.Visible = True
        Form_frmKalender!Sub4.Visible = True
        Form_frmKalender!Sub5.Visible = True
        Form_frmKalender!Sub6.Visible = True
    Case 2
        Form_frmKalender!Sub1.Visible = False
        Form_frmKalender!Sub2.Visible = True
        Form_frmKalender!Sub3.Visible = True
        Form_frmKalender!Sub4.Visible = True
        Form_frmKalender!Sub5.Visible = True
        Form_frmKalender!Sub6.Visible = True

    Case 3
        Form_frmKalender!Sub1.Visible = False
        Form_frmKalender!Sub2.Visible = False
        Form_frmKalender!Sub3.Visible = True
        Form_frmKalender!Sub4.Visible = True
        Form_frmKalender!Sub5.Visible = True
        Form_frmKalender!Sub6.Visible = True
    
    Case 4
        Form_frmKalender!Sub1.Visible = False
        Form_frmKalender!Sub2.Visible = False
        Form_frmKalender!Sub3.Visible = False
        Form_frmKalender!Sub4.Visible = True
        Form_frmKalender!Sub5.Visible = True
        Form_frmKalender!Sub6.Visible = True
    
    Case 5
        Form_frmKalender!Sub1.Visible = False
        Form_frmKalender!Sub2.Visible = False
        Form_frmKalender!Sub3.Visible = False
        Form_frmKalender!Sub4.Visible = False
        Form_frmKalender!Sub5.Visible = True
        Form_frmKalender!Sub6.Visible = True
    
    Case 6
        Form_frmKalender!Sub1.Visible = False
        Form_frmKalender!Sub2.Visible = False
        Form_frmKalender!Sub3.Visible = False
        Form_frmKalender!Sub4.Visible = False
        Form_frmKalender!Sub5.Visible = False
        Form_frmKalender!Sub6.Visible = True
    
    Case 7
        Form_frmKalender!Sub1.Visible = False
        Form_frmKalender!Sub2.Visible = False
        Form_frmKalender!Sub3.Visible = False
        Form_frmKalender!Sub4.Visible = False
        Form_frmKalender!Sub5.Visible = False
        Form_frmKalender!Sub6.Visible = False
    End Select
    
End Sub

Public Sub KleurVandaag()
If Int(cboMaand) = Month(Date) Then
    If cboJaar = Year(Date) Then
        For a = 1 To 37
            If Me.Controls("txt" & a) = Day(Date) Then
                Me.Controls("txt" & a).BackColor = RGB(0, 255, 255)
                Me.Controls("sub" & a).BorderColor = RGB(0, 255, 255)
            End If
        Next a
    
    End If
End If
End Sub

Public Sub KleurNiets()
Dim lngwit As Long
Dim lngzwart As Long

lngwit = RGB(255, 255, 255)
lngzwart = RGB(0, 0, 0)
For a = 1 To 37
Me.Controls("txt" & a).BackColor = lngwit
Me.Controls("sub" & a).BorderColor = lngzwart
Next a

End Sub

Public Sub VerbergLaatste()

Select Case LaatsteWeekdag
    Case 29
    Sub29.Visible = False
    Sub30.Visible = False
    Sub31.Visible = False
    Sub32.Visible = False
    Sub33.Visible = False
    Sub34.Visible = False
    Sub35.Visible = False
    Sub36.Visible = False
    Sub37.Visible = False

    Case 30
    Sub29.Visible = True
    Sub30.Visible = False
    Sub31.Visible = False
    Sub32.Visible = False
    Sub33.Visible = False
    Sub34.Visible = False
    Sub35.Visible = False
    Sub36.Visible = False
    Sub37.Visible = False
    
    Case 31
    Sub29.Visible = True
    Sub30.Visible = True
    Sub31.Visible = False
    Sub32.Visible = False
    Sub33.Visible = False
    Sub34.Visible = False
    Sub35.Visible = False
    Sub36.Visible = False
    Sub37.Visible = False

    Case 32
    Sub29.Visible = True
    Sub30.Visible = True
    Sub31.Visible = True
    Sub32.Visible = False
    Sub33.Visible = False
    Sub34.Visible = False
    Sub35.Visible = False
    Sub36.Visible = False
    Sub37.Visible = False
   
    Case 33
    Sub29.Visible = True
    Sub30.Visible = True
    Sub31.Visible = True
    Sub32.Visible = True
    Sub33.Visible = False
    Sub34.Visible = False
    Sub35.Visible = False
    Sub36.Visible = False
    Sub37.Visible = False
    
    Case 34
    Sub29.Visible = True
    Sub30.Visible = True
    Sub31.Visible = True
    Sub32.Visible = True
    Sub33.Visible = True
    Sub34.Visible = False
    Sub35.Visible = False
    Sub36.Visible = False
    Sub37.Visible = False
    
    Case 35
    Sub29.Visible = True
    Sub30.Visible = True
    Sub31.Visible = True
    Sub32.Visible = True
    Sub33.Visible = True
    Sub34.Visible = True
    Sub35.Visible = False
    Sub36.Visible = False
    Sub37.Visible = False
    
    Case 36
    Sub29.Visible = True
    Sub30.Visible = True
    Sub31.Visible = True
    Sub32.Visible = True
    Sub33.Visible = True
    Sub34.Visible = True
    Sub35.Visible = True
    Sub36.Visible = False
    Sub37.Visible = False
    
    Case 37
    Sub29.Visible = True
    Sub30.Visible = True
    Sub31.Visible = True
    Sub32.Visible = True
    Sub33.Visible = True
    Sub34.Visible = True
    Sub35.Visible = True
    Sub36.Visible = True
    Sub37.Visible = False
    
    Case 38
    Sub29.Visible = True
    Sub30.Visible = True
    Sub31.Visible = True
    Sub32.Visible = True
    Sub33.Visible = True
    Sub34.Visible = True
    Sub35.Visible = True
    Sub36.Visible = True
    Sub37.Visible = True
End Select
End Sub

Private Sub VulGegevens()
For a = 1 To 37
Me.Controls("sub" & a).Form.Filter = "month(datum)='" & cboMaand & "'" & " and year(datum)='" & cboJaar & "'" & "and day(datum) = '" & Me.Controls("txt" & a) & "'"
Next a
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan