Tijdens het selecteren van een rij cellen een balkje erboven laten meelopen

Status
Niet open voor verdere reacties.
Ik kom niet verder dan 1 cel tegelijk.
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim R As Range
Set R = Cells(6, 3).Resize(1, 34)
For Each C In R
If C.Column = ActiveCell.Column Then
C.Interior.Color = vbGreen
Else
C.Interior.Color = xlNone
End If
Next
End Sub




Deze werkt zoals je wilt volgens mij:

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim R As Range
Set R = Cells(6, 3).Resize(1, 34)
For Each C In R
If C.Column >= Target.Column And C.Column <= Selection.Column + Selection.Columns.Count - 1 Then
C.Interior.Color = vbGreen
Else
C.Interior.Color = xlNone
End If
Next

End Sub
 

Bijlagen

  • SelectieHighlight.xlsm
    19,8 KB · Weergaven: 42
Laatst bewerkt:
Hallo Sjon,

Hartelijk dank voor je snelle antwoord en oplossing. Dat werkt prima!
Maar eigenlijk zou ik ditzelfde willen zien al tijdens het selecteren.
Dat zou wel heel fijn zijn.
Mocht dat niet kunnen, dan ga ik sowieso met jouw oplossing verder.

Groet,
Erik
 
Ik begrijp je wens, en ook waarom, maar ik zou niet weten hoe ik naar die handeling kan verwijzen. DIt is mijn max qua kennis.

Misschien komt er nog iemand anders die dat wel weet.
 
Dit heeft mij in ieder geval een heel stuk op weg geholpen en ga ik gebruiken als er geen andere oplossingen komen.
En....heb weer wat bijgeleerd. Thanks.
 
Kleine aanpassing gedaan die ervoor zorgt dat alleen binnen je rooster geselecteerde cellen de boel laten kleuren.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim R As Range
Set R = Cells(6, 3).Resize(1, 34)
For Each C In R
    If C.Column >= Selection.Column And C.Column <= Selection.Column + Selection.Columns.Count - 1 And Selection.Row > 6 And Selection.Row < 18 Then
    C.Interior.Color = vbGreen
    Else
    C.Interior.Color = xlNone
    End If
Next

End Sub
 
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Cells(6, 3).Resize(, 34).Interior.Color = xlNone
  If Not Intersect(Target, Columns(3).Resize(, 34)) Is Nothing Then Intersect(Target, Columns(3).Resize(, 34)).Offset(-Target.Row + 6).Interior.ColorIndex = 12
End Sub
 
Sjon en SNB,
Hartelijk dank voor het meedenken en geven van de oplossing.
Met jouw laatste kan er inderdaad niet buiten het kader gewerkt worden Sjon.

Omdat het waarschijnlijk niet mogelijk is om tijdens het selecteren de balk te laten verschijnen ga ik dit draadje sluiten.
 
Deze werkt alleen als je maar 1 keer dezelfde kleur gebruikt in een rij. Anders wordt het wat complexer.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Cells(6, 3).Resize(, 34).Interior.Color = xlNone
  If Not Intersect(Target, Columns(3).Resize(, 34)) Is Nothing Then
    For j = 3 To 37
      If Cells(Target.Row, j).Interior.Color = Target.Interior.Color Then
        If s = 0 Then s = j
        t = t + 1
        ElseIf s > 0 Then Exit For
      End If
    Next j
    Cells(6, s).Resize(, t).Interior.Color = vbGreen
  End If
End Sub
 
Dankjewel voor het meedenken VenA.
Bij jouw oplossing echter wordt de hele tijdbalk ge"highlight".
Ik ga hem nu gebruiken zoals Sjon hem heeft gebouwd.........mocht er nog iemand zijn die de highlight kan laten plaatsvinden TIJDENS het selecteren, dan hou ik me aanbevolen.
 
Niet de hele tijdbalk wordt ge"highlight" alleen het gedeelte van cellen vanaf linksaf gezien die dezelfde kleur hebben als de geselecteerde cel. Klik bv in E9 en dan worden de tijden die bij de zwarte balk horen groen.

De code van snb moet je ook even beter testen. Een cel aanklikken, de linkermuisknop vasthouden, naar rechts of links slepen en dan de knop loslaten. Tijdens het selecteren lijkt mij niet mogelijk.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan