XL 2016 planning horaire hebdomadaire

p56 à dit:

Bonjour,
Alors d'abord basique, pour colorer une sélection quelconque de cellules à la souris, dans le code de la feuille concernée, un code du genre :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer

    For i = 0 To Target.Columns.Count - 1
        Me.Cells(Target.Row, Target.Column + i).Interior.Color = &HFF
    Next i
End Sub

Ensuite, s'il faut limiter sur une seule ligne avec plus d'une colonne, le code devient :

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer

    If Target.Rows.Count = 1 And Target.Columns.Count > 1 Then
        For i = 0 To Target.Columns.Count - 1
            Me.Cells(Target.Row, Target.Column + i).Interior.Color = &HFF
        Next i
    End If
End Sub

Et encore ensuite, s'il faut limiter sur une ou plusieurs zones particulières le code est alors :

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer, Zn As Range

    Set Zn = Union(Me.Range("S3:BS8"), Me.Range("S11:BS16"))
    If Not Intersect(Target, Zn) Is Nothing And Target.Rows.Count = 1 And Target.Columns.Count > 1 Then
        For i = 0 To Target.Columns.Count - 1
            Me.Cells(Target.Row, Target.Column + i).Interior.Color = &HFF
        Next i
    End If
End Sub

Et on peut aussi prévoir un droit à modifier, pour inverser la couleur, avec ce code :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer, Zn As Range

    Set Zn = Union(Me.Range("S3:BS8"), Me.Range("S11:BS16"))
    If Not Intersect(Target, Zn) Is Nothing And Target.Rows.Count = 1 And Target.Columns.Count > 1 Then
        For i = 0 To Target.Columns.Count - 1
            Me.Cells(Target.Row, Target.Column + i).Interior.Color = _
                IIf(Me.Cells(Target.Row, Target.Column + i).Interior.Color = &HFF, &HFFFFFF, &HFF)
        Next i
    End If
End Sub

Autre façon d'écrire pour le même effet :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Zn As Range, Cel As Range

    Set Zn = Union(Me.Range("S3:BS8"), Me.Range("S11:BS16"))
    If Not Intersect(Target, Zn) Is Nothing And Target.Rows.Count = 1 And Target.Columns.Count > 1 Then
        For Each Cel In Range(Target.Address)
            Cel.Interior.Color = IIf(Cel.Interior.Color = &HFF, &HFFFFFF, &HFF)
        Next Cel
    End If
End Sub

Nb : avec ces codes, les MFC sont à supprimer

Ensuite s'il faut enregistrer quelque part les info saisies à la souris, on peut aussi proposer du code.
P

Cliquez pour agrandir...

p56 à dit:

Re,

Alors pour votre fichier c'est simple. On garde la MFC et le code devient un truc genre :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Zn As Range, i As Integer, Cl As Integer

    Set Zn = Union(Me.Range("S3:BS8"), Me.Range("S11:BS16")) 'etc ...
    If Not Intersect(Target, Zn) Is Nothing And Target.Rows.Count = 1 And Target.Columns.Count > 1 Then
        With Sheets("Planning")
            Cl = .Cells(Target.Row, "B").End(xlToRight).Column + 1
            .Cells(Target.Row, Cl).Value = Me.Cells(2, Target.Column).Value
            .Cells(Target.Row, Cl + 1).Value = Me.Cells(2, Target.Column + Target.Columns.Count - 1).Value
        End With
    End If
End Sub

Ceci dit, juste une remarque, pourquoi faire en double ce planning? Ça alourdit inutilement votre fichier.
Amha,il serait plus simple de mettre les données dans une feuille et le planning visuel sur une autre sans doublon. Mais bon...
P.

Cliquez pour agrandir...

p56 à dit:

Avec un poil de restructuration =>
Regarde la pièce jointe 1159140
P.

Cliquez pour agrandir...