Gebiede tussen 2 cellen kleurgeven in vakantie planning..

Status
Niet open voor verdere reacties.
T

Takelwagen

Gebruiker
Lid geworden
16 feb 2008
Berichten
31
Ik heb een vakantie planning gemaakt. Nu is dat geen probleem, maar nu heb ik een userform gemaakt om de vakantie via dit formulier in te vullen. De bedoeling is dat met de eerste combobox de naam geselecteerd wordt en dus de juiste rij. Daarna zijn er twee textboxen waar een datum moet worden ingevuld. Nu is de bedoeling dat waneer er een persoon en de vakantie van en tot (datum) is ingevuld het gebied tussen de datums in de juiste rij groen gekleurd wordt. Ik weet het ik leg het een beetje onduidelijk uit, gelukkig heb ik een voorbeeld zodat het één en ander wat duidelijker wordt.

Ik heb zelf het één en ander geprobeerd zodra je het vba opent en je kijkt achter het script van het userform zul je het zien. Wat doe ik nu eigenlijk fout?!

Bedank!
 

Bijlagen

Je moet al eerst beginnen met variabelen te benoemen (declareren).

Wat doet de Cells achter b en c?

Waarom een For-Next lus waarin niets gebeurt?

Deze syntax kan ook helemaal niet:

Code: 
ith Worksheets("Planning 2008").Range(vak).Cells(vRij).Value = _
                         Selection.Interior

En zoeken op datums in VBA is niet zo simpel als het daar in de code gedaan wordt, jammer genoeg.

Wigi
 
indd....

Ja dat is niet zo slim:$...Ik zie het... Maar wigi hoe kan ik het dan het beste aanpakken?
 
declareren, is toch niet verplicht?!

Als ik niks declareer dan wordt er toch automatisch gedeclareerd als variant(toch?)
 
Je zult de eerste en de laatste cel moeten bepalen die gevuld moeten worden. Dan kun je de volgende code gebruiken:
Code: 
    Kleur = 4
    Range(KolomVan & Rij, KolomTot & Rij).Select
    Selection.Interior.ColorIndex = Kleur
Kleur is hier dan een kleurenindex. Voor groen gebruik je dus kleur = 4
 
ok ik ga eens even kijken

En meneer Hoornvan, is dat nu echt nodig?!(beetje jammer.....)
 
Takelwagen zei:
En meneer Hoornvan, is dat nu echt nodig?!(beetje jammer.....)
Klik om te vergroten...

Groot gelijk.

Het kan zijn dat:

Ik start ook wel eens met een leeg bestand op een andere PC.
Of werk ik verder met iemands anders bestanden en maak er iets nieuws van.
En wat als Excel geïnstalleerd werd met de naam van de vrouw/vriendin van de topic starter?

Kortom, redelijk nutteloze opmerking een paar posts hierboven van een anders zeer gewaardeerd helper.

Wigi
 
Laatst bewerkt:
Heb nu dit...

Ik heb het nu anders geprobeerd(met week nr. en dag d.m.v. listindex). Alleen nu krijg ik nog steedts niet echt wat ik wil. De lus zelf lukt volgens mij wel, ik heb in het voorbeeld nu een extra tabblad en als je daar kijkt zie je precies wat ik bedoel. Er gaat iets kleins mis maar wat?! Gaarne uitleg

Thanx Wigi
 

Bijlagen

Takelwagen zei:
Ik heb het nu anders geprobeerd(met week nr. en dag d.m.v. listindex). Alleen nu krijg ik nog steedts niet echt wat ik wil. De lus zelf lukt volgens mij wel, ik heb in het voorbeeld nu een extra tabblad en als je daar kijkt zie je precies wat ik bedoel. Er gaat iets kleins mis maar wat?! Gaarne uitleg

Thanx Wigi
Klik om te vergroten...

Dit komt doordat je met het getal van de kolom werkt, terwijl deze een letter verwacht. Met de volgende functie kun je de getallen (kolom1 en kolom2) omzetten naar de juiste letters.
Code: 
Function ColumnLetter(ColumnNumber As Integer) As String
  If ColumnNumber > 26 Then

    ' 1st character:  Subtract 1 to map the characters to 0-25,
    '                 but you don't have to remap back to 1-26
    '                 after the 'Int' operation since columns
    '                 1-26 have no prefix letter

    ' 2nd character:  Subtract 1 to map the characters to 0-25,
    '                 but then must remap back to 1-26 after
    '                 the 'Mod' operation by adding 1 back in
    '                 (included in the '65')

    ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
                   Chr(((ColumnNumber - 1) Mod 26) + 65)
  Else
    ' Columns A-Z
    ColumnLetter = Chr(ColumnNumber + 64)
  End If
End Function
Succes!
 
Nou eerlijk gezegd,

het lukt me nog steedts niet. Ik snap de functie wel maar waar moet ik die neer zetten en hoe rope ik deze aan dan in me script?
 
Code: 
Private Sub CommandButton1_Click()

Medw = ComboBox1.Value
Datum1 = TextBox1.Value
Datum2 = TextBox2.Value
test = Range("C3").Value


With Sheets("Planning 2008").Range("A1:IS60")
Set a = .Find(Medw, LookIn:=xlValues, lookat:=xlWhole)
If Not a Is Nothing Then
    vRij = a.Row

    With Sheets("Planning 2008").Range("A3:IS3")
    Set b = .Find(Datum1, LookIn:=xlValues, lookat:=xlPart)
    If Not b Is Nothing Then
        kRij1 = b.Column

        Set c = .Find(Datum2, LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
            kRij2 = c.Column
        End If
    End If
    End With
        
rBereik1 = Cells(vRij, kRij1).Address
rBereik2 = Cells(vRij, kRij2).Address
Range(rBereik1, rBereik2).Select

Selection.Interior.ColorIndex = 4
Selection.Interior.Pattern = xlSolid

End If
End With
        
    

End Sub

Bovenstaande code werkt, ECHTER je moet de celeigenschappen van de rij met de datums wijzigen van '#Datum' naar gewoon 'Tekst'.
Ik ben er nog niet achter waarom hij geen datums wilt vinden.
 
Code: 
Private Sub CommandButton1_Click()

Medw = ComboBox1.Value
Datum1 = CDate(TextBox1.Value)
Datum2 = CDate(TextBox2.Value)
test = Range("C3").Value


With Sheets("Planning 2008").Range("A1:IS60")
Set a = .Find(Medw, LookIn:=xlValues, lookat:=xlWhole)
If Not a Is Nothing Then
    vRij = a.Row

    With Sheets("Planning 2008").Range("A3:IS3")
    Set b = .Find(Datum1, LookIn:=xlValues, lookat:=xlPart)
    If Not b Is Nothing Then
        kRij1 = b.Column

        Set c = .Find(Datum2, LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
            kRij2 = c.Column
        End If
    End If
    End With
        
rBereik1 = Cells(vRij, kRij1).Address
rBereik2 = Cells(vRij, kRij2).Address
Range(rBereik1, rBereik2).Select

Selection.Interior.ColorIndex = 4
Selection.Interior.Pattern = xlSolid

End If
End With
        
End Sub

Dan werkt deze code dus wel.
(Dankje wel Wigi.)

Probeer deze code eens Takelwagen.
 
hmm heb het geprobeerd..

Maar het lukt niet echt...Maar in mijn vorige voorbeeld lukt het wel om de twee juiste cellen te vinden. Het lukt alleen niet om te selecteren en het juiste kleurtje te geven. In plaats daarvan komt het index nr in de cel te staan?!...
 
Takelwagen zei:
Maar het lukt niet echt...Maar in mijn vorige voorbeeld lukt het wel om de twee juiste cellen te vinden. Het lukt alleen niet om te selecteren en het juiste kleurtje te geven. In plaats daarvan komt het index nr in de cel te staan?!...
Klik om te vergroten...

Wat lukt er dan niet echt ?
 
Hallo Takelwagen,

Hij werkt (Alleen op de personen), ik heb in de code textBox veranderd in ComboBox.
De weeknummers pakt hij ook niet, ik heb het geprobeerd in het eerste vak week 13.
Dus van week 13 naar week 14 doet het niet.

Verder weet ik het ook niet.

Mvg,
Wim
 

Bijlagen

het is gelukt, maar....

In het bijgevoegde voorbeeld is het gelukt. Als je het gezien hebt dan zie je hoe het werkt(Ik heb zoals in de berichten hiervoor geschreven staat, De datums staan in rij 3 of 4 en ik heb als celeigenschappen tekst. Die betreffende rij zo klein mogelijk gemaakt want verbergen kan niet dan loopt de macro vast).

Het enige probleem is dat wanneer er een datum in de combobox wordt ingevuld en ik ga naar de volgende combobox dan verspringt de datum naar een getal. Is dit niet te voorkomen?, staat niet zo netjes namelijk.
 

Bijlagen

O ja...

Op een of andere manier is het niet mogelijk om een vakantie in te plannen in de laatste week?!...
 
Takelwagen zei:
Op een of andere manier is het niet mogelijk om een vakantie in te plannen in de laatste week?!...
Klik om te vergroten...

Wat ik niet begrijp ....
Die code die ik je eerst gaf werkt bij mij (excel 2003) perfect. En zoeken op datum, dus geen tekst-eigenschappen etc. Dus snap nog steeds niet wat er verkeerd is gegaan bij jou.
Ok de laatste week werkt goed. Hoe vul jij trouwens de datum in ?
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan