Voorwaardelijke opmaken worden er steeds meer

[Joete]

Voorwaardelijke opmaak in VBA - cellen in voettekst - functie verschuiving

Hallo,

Ik heb in Excel een kleine, eenvoudige, planning gemaakt.
Hierin geef ik met een letter(combinatie) aan wat de actie is voor die dat.
Aan die letters heb ik voorwaardelijke opmaken gehangen die de cel een bepaalde kleur geven.

De planning veranderd iedere week:
- Wekelijks opschuiven
- Nieuwe projecten toevoegen bij de diverse collega's
- Nieuwe collega's toevoegen
- Enz..

Door het aanpassen (knippen/kopieren/toevoegen/plakken) ga ik van 6 voorwaardelijke opmaken (door mij aangemaakt) die gelden voor cellen $E$12 t/m $IV$65536, naar een stuk of 30 opmaken die gelden voor allemaal tussen regels/kolommen/cellen.
De opmaken doen hetzelfde, maar ik wil niet dat bepaalde opmaken overschreven worden en daarbij wil ik er af en toe 1 toevoegen als we een nieuwe actie er bij willen vermelden. Het lijstje wordt dus erg onoverzichtelijk na het kopieren van cellen/rijen/kolommen.

Is daar iets aan te doen? Is het te voorkomen dat opmaken verdwijnen? Zou ik een voorwaardelijke opmaak voor bovenstaand bereik beter in macro kunnen zetten? Kan ik zo'n macro dan continu door laten lopen dat als ik een letter type deze direct de opmaak meegeeft? Of moet ik dan de macro steeds activeren?

Het mooist zou zijn als Excel niet zo eigenwijs is maar eens bedenkt dat de cellen al binnen de voorwaardelijke opmaak vallen...

 

[Cobbe]

Vlooi dit eens uit, je kan die 0....9 vervangen door elke invoer.
Deze code in een Change-event loopt volledig automatisch.
Je moet het actieterrein wel beperken tot het invoerbereik.

 With Target

    Select Case .Value
      Case Is = ""
          .Interior.ColorIndex = 0
      Case Is = 1
          .Interior.ColorIndex = 6
      Case Is = 2
          .Interior.ColorIndex = 6
      Case Is = 3
          .Interior.ColorIndex = 3
      Case Is = 4
          .Interior.ColorIndex = 4
      Case Is = 5
          .Interior.ColorIndex = 9
      Case Is = 6
          .Interior.ColorIndex = 7
          .Font.ColorIndex = 7
      Case Is = 7
          .Interior.ColorIndex = 5
          .Font.ColorIndex = 5
      Case Else
          .Interior.ColorIndex = xlNone
    End Select

   End With
End If
End Sub

 

[Joete]

OK, nog niet geprobeerd, ga ik straks doen.
Ziet er zo op het eerste oog logisch uit.

Wel een paar vraagjes:
- Hoe kan ik bekijken welke kleurcode bij de door mij gebruikte kleuren hoort?
- Ik gebruik ook lettercombinaties (bv. cl = calculatie (c) voorlopig (l)). Kan dat ook met deze code? C wordt bij mij oranje, L trekt er een witte arcering overheen. Hoe gaat dat in VBA?
- Je hebt het over een bereik, hoe zet ik die vast? In mijn geval vanaf E12 tot eind.

 

[Cobbe]

Hier een bestandje met de kleuren en bijhorende codes(nummers).

 

[Joete]

Top!
Het is gelukt!

Deze code heb ik er in geplaatst:

Private Sub Worksheet_CHange(ByVal Target As Excel.Range)
    With Target
        Select Case .Value
'       leeg
            Case Is = ""
                .Interior.ColorIndex = xlNone
                .Font.ColorIndex = xlNone
'       calculatie
            Case Is = "c"
                .Interior.ColorIndex = 45
                .Font.ColorIndex = 45
            Case Is = "cl"
                .Interior.ColorIndex = 45
                .Font.ColorIndex = 45
                .Interior.Pattern = xlPatternUp
                .Interior.PatternColorIndex = 2
'       aanbesteding
            Case Is = "a"
                .Interior.ColorIndex = 3
                .Font.ColorIndex = 3
            Case Is = "al"
                .Interior.ColorIndex = 3
                .Font.ColorIndex = 3
                .Interior.Pattern = xlPatternUp
                .Interior.PatternColorIndex = 2
'       aanwijs
            Case Is = "w"
                .Interior.ColorIndex = 33
                .Font.ColorIndex = 33
            Case Is = "wl"
                .Interior.ColorIndex = 33
                .Font.ColorIndex = 33
                .Interior.Pattern = xlPatternUp
                .Interior.PatternColorIndex = 2
'       vakantie/vrij
            Case Is = "v"
                .Interior.ColorIndex = 43
                .Font.ColorIndex = 43
            Case Is = "vl"
                .Interior.ColorIndex = 43
                .Font.ColorIndex = 43
                .Interior.Pattern = xlPatternUp
                .Interior.PatternColorIndex = 2
'       vragen
            Case Is = "r"
                .Interior.ColorIndex = 23
                .Font.ColorIndex = 23
            Case Is = "rl"
                .Interior.ColorIndex = 23
                .Font.ColorIndex = 23
                .Interior.Pattern = xlPatternUp
                .Interior.PatternColorIndex = 2
'       presentatie
            Case Is = "p"
                .Interior.ColorIndex = 55
                .Font.ColorIndex = 55
            Case Is = "pl"
                .Interior.ColorIndex = 55
                .Font.ColorIndex = 55
                .Interior.Pattern = xlPatternUp
                .Interior.PatternColorIndex = 2
'       anders leeg
            Case Else
                .Interior.ColorIndex = xlNone
                .Font.ColorIndex = xlNone
        End Select
    End With
End Sub

Nu alleen nog 1 vraagje:
Als ik nu een legenda in mijn voettekst wil plaatsen, hoe doe ik dat?
Ik kan in de voettekst niet verwijzen naar cellen, titels kan wel weer, maar die kan ik niet vanaf een ander werkblad halen...
Iemand een idee hoe ik dat het beste kan doen?

 

[Warme bakkertje]

Plaats eens een voorbeeldbestandje met wat je graag in je voettekst zou zien.

 

[Joete]

Sorry, had een deadline op het werk, dus kon me even niet bezighouden met de planning en codes.
Bij deze weer een aanvulling als gevraagd: een voorbeeld bestandje.

Het gaat om de bovenste 3 regels (cellen A1 t/m G3) welke ik graag in een voettekst zou zijn. Het liefst heb ik hem, als ie het ergens moet hebben staan om over te nemen, op een ander werkblad zodat ie hier uit beeld is... Nu druk ik hem af als titel, maar dat heeft niet mijn voorkeur...

Nog een klein ander vraagje:
Ik werk met een dynamisch afdrukbereik (onder formules/namen beheren):

=VERSCHUIVING(Planning!$A$11;0;0;AANTALARG(Planning!$D$17:$D$282)+17;AANTAL.ALS(Planning!$I$11:$IA$11;1)+9)

Waarbij ik in een van de regels kijk of daar iets staat of niet, om vervolgens te zeggen hoeveel rijen en kolommen ik van mijn beginpunt op moet schuiven. Het werkt mooi, maar mijn systeem is natuurlijk nooit waterdicht aangezien ik in rij 11 controleer of een minimaal aantal cellen gevuld is of niet met de code:

=ALS(AANTALARG(I:M)>6;1;0)

Die 1-tjes tel ik vervolgens dus in mijn verschuivingscode hierboven.
De vraag: Is er voor die verschuiving ook een andere code mogelijk? Een code waarbij ik sowieso altijd de laatste ingevulde rij en kolom pak?

Hoop dat het een beetje duidelijk is... :shocked:

 

[Joete]

Iemand???