XL 2016 récupérer textbox dans une cellule fusionnée

[halecs93]

Bonjour à toutes et à tous (oups, je n'ai pas oublié cette fois)

J'ai commence à bricoler un ficher me permettant d'organiser un planning de travail. Chaque cellule correspondant à 15 minutes, je peux (cliquer-glisser) sélectionner un certain nombre de cellules qui vont alors se fusionner (double clic pour les défusionner).

Lors de la fusion, un userform s'affiche. Celui ci contient un textbox et un choix de couleurs avec des cases d'option. Je n'arrive pas à récupérer ces infos pour : afficher le contenu du userform dans les cellules qui viennent d'être fusionnées et de leur attribuer en couleur de fond celle qui a été défini avec les cases d'option.

Je joins un fichier anonymisé et mon grand merci

 

[laurent950]

Bonsoir @halecs93

La correction de votre code est ici : Fuil 1 (SEM 1)

Pour Info : Le Numéro de la couleur ne correspond pas Selection.Interior.Color = ?
' Pour Obtenir la couleur d'arrière-plan (BackColor) de l'OptionButton
' CouleurFond = MaOptionBouton.BackColor

Vous avez le choix de définir vos couleur, a moins qu'il y ait une personne qui trouve la correspondance mais je pense que cela n'est pas compatible.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then
        ' Vérifie si la sélection contient plus d'une cellule
        On Error Resume Next
        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
        End If
    
        On Error GoTo 0
    
        Target.Value = UserForm1.TextBox1.Value
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = CLng(UserForm1.TextBox1.Tag) ' Rouge
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    
        ' 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
        Dim MergedCount As Integer
        MergedCount = 0
    
        Dim Cell As Range
        For Each Cell In Target
            If Cell.MergeCells Then
                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 = Hours / 24
        End If
    
        ' 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 Sub

Private 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
        On Error Resume Next
      
        ' 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
        On Error GoTo 0
    End If
    ' Annuler le déclenchement du UserForm par défaut
    Cancel = True
End Sub

puis ici UserForm1
ici Me.TextBox1.Tag = selectedColor 'l'option Tag n'est pas terrible mais cela dépanne !

Private Sub CommandButton1_Click()
    Dim info As String
    info = Me.TextBox1.Value
    ' Vérifier quel bouton d'option est sélectionné
    Dim selectedColor As String
    Dim MonOptionButton As Object
    For Each MonOptionButton In Me.Controls
    If TypeOf MonOptionButton Is MSForms.OptionButton Then
    If MonOptionButton.Value = True Then
    Select Case MonOptionButton.Name
        Case "RedOptionButton"
            selectedColor = 5460991: Exit For 'vbRed: Représente la couleur rouge.
        Case "BlueOptionButton"
            selectedColor = 16770719: Exit For 'vbBlue: Représente la couleur bleue.
        Case "OrangeOptionButton"
            selectedColor = 6150399: Exit For 'vbBlue: Représente la couleur orange.
        Case "GreenOptionButton"
            selectedColor = 10747735  : Exit For 'vbGreen: Représente la couleur verte.
        Case "YellowOptionButton"
            selectedColor = 6684671: Exit For ' vbYellow: Représente la couleur jaune
        Case "PurpleOptionButton"
            selectedColor = 14652863: Exit For 'vbViolet: Représente la couleur violette.
    End Select
    End If
    End If
    Next MonOptionButton
        Me.TextBox1.Tag = selectedColor
 
    ' Fermer l'UserForm
    Me.Hide
 
End Sub

 

[laurent950]

En revanche, je n'arrive pas à dénombrer le nombre de cellules qui ont été fusionnées sur la ligne concernée. En effet, le calcul ne prend en compte que la dernière fusion.

Bonjour @halecs93
Cela veux dire quoi.
Vous pouvez expliquer ? C'était pas dans la demande initiale !
Je vous propose de notifié cette discussion à resolu et d'en créer une nouvelle pour vous répondre sur celle-ci.

 

[laurent950]

Bonjour @halecs93

Pour Info : Le Numéro de la couleur ne correspond pas Selection.Interior.Color = ?
' Pour Obtenir la couleur d'arrière-plan (BackColor) de l'OptionButton
' CouleurFond = MaOptionBouton.BackColor

Petit bonus :
- j'ai trouvé trouvé comment récupérer le code couleur des OptionButton, la valeur de type Long récupéré avec Object.BackColor est converti en RGB, une fonction dont je stock les trois conversions : je stock chacun des résultat dans une variable tableau, que je renvois au module standard pour y appliqué l'équivalence couleur de fond de cellule a la sélection Excel.

Maintenant il n'y a plus besoin de constituer les couleurs utilisé avec le Select Case pour y adapter une correspndance couleurs car a prèsent les fond de couleur des OptionBoutons sont récupérer y colorié la selection des cellules Excel.

' Appliquez la couleur spécifiée à la cellule Excel
        Dim CodeCouleur As Variant
        Dim RedValue As Integer
        Dim GreenValue As Integer
        Dim BlueValue As Integer
            CodeCouleur = AppliquerCouleurOptionButtonACellule(UserForm1)
            'Target.Interior.Color = RGB(RedValue, GreenValue, BlueValue)
            Target.Interior.Color = RGB(CodeCouleur(0), CodeCouleur(1), CodeCouleur(2))

Function AppliquerCouleurOptionButtonACellule(ByVal Usf As UserForm) As Variant()
    Dim MonOptionButton As Object
    Dim CodeCouleur(0 To 2) As Variant
    Dim RedValue As Integer
    Dim GreenValue As Integer
    Dim BlueValue As Integer
   
' Vérifier quel bouton d'option est sélectionné
    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
                RedValue = MonOptionButton.BackColor Mod 256
                GreenValue = (MonOptionButton.BackColor \ 256) Mod 256
                BlueValue = (MonOptionButton.BackColor \ 65536) Mod 256
            ' Utilisez RGB pour spécifier la couleur en utilisant les composantes RVB
                'CodeCouleur = RGB(RedValue, GreenValue, BlueValue)
                CodeCouleur(0) = RedValue
                CodeCouleur(1) = GreenValue
                CodeCouleur(2) = BlueValue
            ' Sortie de boucle
                Exit For
            End If
        End If
    Next MonOptionButton
    AppliquerCouleurOptionButtonACellule = CodeCouleur
End Function