wijzigingen in werkboek als kleur wijzigt in takenblad

Status
Niet open voor verdere reacties.
S

StephaanK

Gebruiker
Lid geworden
19 jun 2015
Berichten
34
ik heb een takenblad waarbij onderstaande routine werkt (met dank aan edmoor celkleur ophalen op basis van inhoud array/celkleur)
ik heb het origineel
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
gewijzigd naar onderstaande om het voor alle sheets actief te maken.
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim i As Integer
    If Target.row < 99 And Target.Column < 26 Then
        With Sheets("takenblad")
            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
dit zorgt er voor dat als ik in een blad een taak kies, de kleur wordt overgenomen van de taak in takenblad (als je taak3 selecteert wordt die cel geel van achtergrond). ik zou nu ook het omgekeerde willen, namelijk dat als ik een taak die nog geen kleur heeft in de takenlijst een kleur geef, dat alle sheets bijgewerkt worden waar die taak te vinden is en dat die de overeenkomstige kleur krijgt.
vb taak4 heeft geen kleur maar als ik die een kleur - paars - zou geven zouden de cellen met taak4 in de sheets ook paars moeten kleuren.

alvast bedankt voor alle input
Stephaan
 

Bijlagen

  • taakkleuren2.xlsx
    13,8 KB · Weergaven: 29
Wil je een oplosssing of hulp bij een oplossing ?
Heb je zelf al wat gedaan ?
 
In ieder geval niet in het voorbeeld document want daar zit geen stukje code in.
Ik zou op het takenblad een knopje maken met code erachter die ineens alle taken in alle bladen van de juiste kleur voorziet.

Zoiets bijvoorbeeld:
Bekijk bijlage taakkleuren2.xlsm
 
Laatst bewerkt:
iets zoals dit , gekoppeld aan change-event van het blad waar de taken op staan.
Code: 
Private Sub kleurenaanpassenobvtaken()
Dim w As Integer
Dim inhoud As String
Dim cel As Range
Dim taken As Variant

taken = Application.Transpose(Sheets("Blad1").Range("e1:e33").Value)

For w = 1 To ThisWorkbook.Worksheets.Count - 1 ' alle sheets behalve de laatste sheet

    For Each cel In werkschema 'werkschema is een range identiek in ieder werkblad
    inhoud = cel.Value
       positie = Application.Match(inhoud, taken, False) ' nagaan of de inhoud van de cel overeenkomt met een taak uit de namedrange taken
       If Not IsError(positie) Then
              cel.Interior.Color = Sheets("Blad1").Cells(positie, "E").Interior.Color
      End If
    Next cel
Next w
End Sub
maar misschien zijn er veel betere en snellere oplossingen.
stephaan
 
Code: 
Sub M_snb()
    For Each sh In Sheets
       For Each cl In Sheets("takenblad").Columns(5).SpecialCells(2)
           sh.UsedRange.FormatConditions.Add(1, 3, "=takenblad!" & cl.Address).Interior.Color = cl.Interior.Color
       Next
    Next
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan