Dim FormatageLigne5 As Variant ' Variable pour stocker le formatage de la ligne 5
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim BoutonActive As Boolean
If Target.Cells.Count > 1 Then
' Vérifie si la sélection contient plus d'une cellule
Dim isHorizontal As Boolean
isHorizontal = False
' Vérifie si la sélection est horizontale
If Target.Rows.Count = 1 Then
isHorizontal = True
End If
' Fusionne uniquement si la sélection est horizontale et dans la plage E:BQ
If isHorizontal And Target.Column >= 5 And Target.Column <= 68 Then
Target.Merge
' Ouvre UserForm1
UserForm1.Show
' Valeur dans la cellule fusionné
Target.Value = UserForm1.TextBox1.Value
' Appliquez la couleur spécifiée à la cellule Excel
Dim CodeCouleur As Variant
'Dim RGB1 As Integer
'Dim RGB2 As Integer
'Dim RGB3 As Integer
CodeCouleur = AppliquerCouleurOptionButtonACellule(UserForm1)
' Target.Interior.Color = RGB(RGB1, RGB2, RGB3)
Target.Interior.Color = RGB(CodeCouleur(0), CodeCouleur(1), CodeCouleur(2))
' Centre le contenu en hauteur et en largeur
With Target
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
' Compte le nombre de cellules fusionnées dans la sélection
CompteCellsFusionnéParLigne Range(Cells(Target.Row, 5), Cells(Target.Row, 69)), Target
' Sauvegarde le formatage de la ligne 5 lors de la première sélection
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
' Si il n'y a aucune valeur dans les cellules
' Lorsqu'une cellule Excel a un fond de couleur blanc
' (ou est définie avec la couleur par défaut "None" ou transparente),
' la valeur RGB de cette cellule est généralement "16777215". Vous pouvez utiliser
' cette valeur pour représenter le blanc dans votre code VBA. Voici comment vous pouvez
' obtenir les composantes RVB de la couleur blanche :
' Dim CodeCouleur(0 To 2) As Integer
RGB1 = 16777215 Mod 256 ' Composante Rouge
RGB2 = (16777215 \ 256) Mod 256 ' Composante Verte
RGB3 = (16777215 \ 65536) Mod 256 ' Composante Bleue
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)
' Cette macro se déclenche lorsque vous double-cliquez sur une cellule
If Target.MergeCells And Target.Column >= 5 And Target.Column <= 68 Then
' Vérifie si la cellule est fusionnée et dans la plage E:BQ
' Rétablir l'alignement par défaut
With Target
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
End With
Target.Interior.Color = xlNone
Target.Value = Empty
' Stocker le formatage de la ligne 5 pour la plage fusionnée
Dim FormatageLigne5 As Range
Set FormatageLigne5 = Me.Cells(5, Target.Column).Resize(1, Target.Columns.Count)
' Appliquer le formatage de la ligne 5 à la plage fusionnée
FormatageLigne5.Copy
Target.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False ' Effacer le presse-papiers
Target.UnMerge
' Compte le nombre de cellules fusionnées dans la sélection
CompteCellsFusionnéParLigne Range(Cells(Target.Row, 5), Cells(Target.Row, 69)), Target
End If
' Annuler le déclenchement du UserForm par défaut
Cancel = True
End Sub
'
Sub CompteCellsFusionnéParLigne(ByVal Rng As Range, ByVal Target As Range)
' Compte le nombre de cellules fusionnées dans la sélection
Dim MergedCount As Integer
MergedCount = 0
' Parcourez les cellules de la colonne 5 à la colonne 69 de la ligne 411
For Each Cell In Rng
If Cell.MergeCells Then
' Si la cellule est fusionnée, augmentez le compteur de 1
MergedCount = MergedCount + 1
End If
Next Cell
' Écrire le nombre d'heures dans la colonne BS
If MergedCount > 0 Then
Dim Hours As Double
Hours = MergedCount * 15 / 60 ' Convertit les 15 minutes en heures (15/60)
' Insère le nombre d'heures sous forme décimale en divisant par 24
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()
' Vérifier quel bouton d'option est sélectionné
Dim MonOptionButton As Object
For Each MonOptionButton In Usf.Controls
If TypeOf MonOptionButton Is MSForms.OptionButton Then
' Vérifiez si l'OptionButton est coché (actif)
If MonOptionButton.Value = True Then
' Remplacez "NomDeLOptionBouton" par le nom réel de votre OptionButton
Set MonOptionButton = Usf.Controls(MonOptionButton.Name)
' Obtenez les composantes RVB de la couleur d'arrière-plan de l'OptionButton
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
' Utilisez RGB pour spécifier la couleur en utilisant les composantes RVB
' CodeCouleur = RGB(RedValue, GreenValue, BlueValue)
CodeCouleur(0) = RGB1
CodeCouleur(1) = RGB2
CodeCouleur(2) = RGB3
' Sortie de boucle
Exit For
End If
End If
Next MonOptionButton
AppliquerCouleurOptionButtonACellule = CodeCouleur
End Function