celkleur ophalen op basis van inhoud array/celkleur

Status
Niet open voor verdere reacties.

StephaanK

Gebruiker
Lid geworden
19 jun 2015
Berichten
34
Ik heb een aantal taken in een namedrange "taken" (blad2)
in blad1 in de grijze zone van doc in bijlage kan een taak gekozen worden uit de lijst gebaseerd op de namedrange .
Ik zou nu via vba er voor willen zorgen dat als gebruikers een kleur gegeven hebben aan een taak in blad2 en ze selecteren een taak in blad1 dat die taak de kleur krijgt van de taak in de namedrange . Tot nu toe deed ik dat met voorwaardelijke opmaak maar omdat er nog andere kleuringen zijn, werd dat zeer onoverzichtelijk en werden soms ook opmaakdefinities verwijderd.
om een voorbeeld te geven: taken 1, 3 en 5 hebben een kleurtje in blad2 (resp. groen, geel , rood).
als het werkboek wordt geopend moeten alle taken 1, 3 en 5 de juiste kleur krijgen en als er één van deze taken wordt ingevuld in het huidige rooster, moet die natuurlijk ook de juiste kleur krijgen.
Ik kan het oplossen met een Case structuur en testen op de inhoud van de cel en daar de kleur aan toewijzen, maar de lijst van taken is vrij lang en kan variëren, evenals de kleuren, daarom zou ik liever via array of zo een oplossing vinden.

grtz
Stephaan
 

Bijlagen

  • taakkleuren.xlsx
    9,8 KB · Weergaven: 27
Zet deze eens achter Blad1:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    If Target.Row < 18 And Target.Column < 11 Then
        With Sheets("Blad2")
            For i = 1 To .Range("taken").Rows.Count
                If .Range("taken")(i) = Target Then
                    Target.Interior.Color = .Range("taken")(i).Interior.Color
                End If
            Next i
        End With
    End If
End Sub
 
Laatst bewerkt:
als ik dat op verschillende sheets wil toepassen, zet ik dat dan per sheet, of kan ik dat in 1 algemene sub zetten? ik heb 8 sheets en het moet voor 6 van e 8 geactiveerd worden.
ik zal de oplossing alleszins uittesten.
bedankt.
S
 
De code zelf kan wel in 1 sub die je dan per werkblad aanroept vanuit Private Sub Worksheet_Change(ByVal Target As Range).
Uiteraard moet je dan wel kijken of de gebruikte cel- en kolomnummers nog kloppen, of deze variabel maken.
 
ik heb het als sub in het werkboek zelf geplaatst en de sub aangepast : Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
de rij/kolomnummers zijn voor ieder sheet gelijk en die heb ik aangepast en het werkt perfect voor alle sheets
bedankt
Stephaan
 
Graag gedaan :)
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan