Dim FormatageLigne5 As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim BoutonActive As Boolean
If Target.Cells.Count > 1 Then
Dim isHorizontal As Boolean
isHorizontal = False
If Target.Rows.Count = 1 Then
isHorizontal = True
End If
If isHorizontal And Target.Column >= 5 And Target.Column <= 68 Then
Target.Merge
UserForm1.Show
Target.Value = UserForm1.TextBox1.Value
Dim CodeCouleur As Variant
CodeCouleur = AppliquerCouleurOptionButtonACellule(UserForm1)
Target.Interior.Color = RGB(CodeCouleur(0), CodeCouleur(1), CodeCouleur(2))
With Target
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
CompteCellsFusionnéParLigne Range(Cells(Target.Row, 5), Cells(Target.Row, 69)), Target
If Target.Row = 5 Then
FormatageLigne5 = Target.EntireRow.Cells(1).EntireRow.Copy
End If
End If
End If
On Error Resume Next
If Target.Resize(1, 1).Value = Empty Then
RGB1 = 16777215 Mod 256
RGB2 = (16777215 \ 256) Mod 256
RGB3 = (16777215 \ 65536) Mod 256
CodeCouleur(0) = RGB1
CodeCouleur(1) = RGB2
CodeCouleur(2) = RGB3
Target.Interior.Color = RGB(CodeCouleur(0), CodeCouleur(1), CodeCouleur(2))
End If
Application.ScreenUpdating = True
End Sub
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.MergeCells And Target.Column >= 5 And Target.Column <= 68 Then
With Target
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
End With
Target.Interior.Color = xlNone
Target.Value = Empty
Dim FormatageLigne5 As Range
Set FormatageLigne5 = Me.Cells(5, Target.Column).Resize(1, Target.Columns.Count)
FormatageLigne5.Copy
Target.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Target.UnMerge
CompteCellsFusionnéParLigne Range(Cells(Target.Row, 5), Cells(Target.Row, 69)), Target
End If
Cancel = True
End Sub
Sub CompteCellsFusionnéParLigne(ByVal Rng As Range, ByVal Target As Range)
Dim MergedCount As Integer
MergedCount = 0
For Each Cell In Rng
If Cell.MergeCells Then
MergedCount = MergedCount + 1
End If
Next Cell
If MergedCount > 0 Then
Dim Hours As Double
Hours = MergedCount * 15 / 60
Me.Cells(Target.Row, "BS").Value = Empty
Me.Cells(Target.Row, "BS").Value = Hours / 24
End If
End Sub
Function AppliquerCouleurOptionButtonACellule(ByVal Usf As UserForm) As Integer()
Dim MonOptionButton As Object
For Each MonOptionButton In Usf.Controls
If TypeOf MonOptionButton Is MSForms.OptionButton Then
If MonOptionButton.Value = True Then
Set MonOptionButton = Usf.Controls(MonOptionButton.Name)
Dim CodeCouleur(0 To 2) As Integer
Dim RGB1 As Integer
Dim RGB2 As Integer
Dim RGB3 As Integer
RGB1 = MonOptionButton.BackColor Mod 256
RGB2 = (MonOptionButton.BackColor \ 256) Mod 256
RGB3 = (MonOptionButton.BackColor \ 65536) Mod 256
CodeCouleur(0) = RGB1
CodeCouleur(1) = RGB2
CodeCouleur(2) = RGB3
Exit For
End If
End If
Next MonOptionButton
AppliquerCouleurOptionButtonACellule = CodeCouleur
End Function