XL 2016 mise en forme de cellules à la fermeture d'un userform

[halecs93]

Bonjour, bonsoir,

Grâce à l'aide glanée ici (et merci Laurent), l'userform se ferme sans soucis en effet. Mais lorsque les cellules se "défusionnent" elle ne reprennent pas le formatage complet de la ligne 5... couleur et bordure....

Encore merci

 

[laurent950]

Re @halecs93

Remise en forme de cellules à la fermeture d'un userform
si c'est résolu alors ont passe ce poste a résolu.

Module Standard Feuil 1 (SEM 1)

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

Code Userform1

Private Sub UserForm_Initialize()
    Me.TextBox1.Value = ""
    Me.CommandButton1.Enabled = False ' Désactiver le bouton au démarrage
End Sub

Private Sub TextBox1_Change()
    If Trim(Me.TextBox1.Value) = "" Then
        Me.CommandButton1.Enabled = False
    Else
        Me.CommandButton1.Enabled = True
    End If
End Sub

Private Sub CommandButton1_Click()
'   Fermer l'UserForm
        Me.Hide
End Sub

Private Sub CommandButton2_Click()
'
'   Fermer l'UserForm si elle est ouverte
        Unload UserForm1
'   Défusionner les cellules
        ActiveCell.UnMerge
End Sub

 

[Staple1600]

Re,

J'ai la berlue ?

Ou des messages apparaissent et disparaissent, dont le dernier qui disait

"C'est résolu! "

 

[Staple1600]

@laurent950
OK merci pour les précisons
J'ai failli prendre RDV chez l'ophtalmo pour changer de lunette

@halecs93
Une autre piste t'intéresse ?
(sans Userform, en utilisant simplement le menu contextuel)
Un petit exemple basique ci-dessous

 

[laurent950]

Re @Staple1600

Cela te parle ce code Style ?
l'utilisation de l'objet de type Style pour stocker la mise en forme actuelle de la plage, puis réappliquer cette mise en forme ultérieurement.
Voici un exemple de code pour accomplir cela que j'ai essayé ?
Mais ce n'est que les couleurs apparemment ?

Sub SauvegarderMiseEnForme()
    Dim Plage As Range
    Dim MaMiseEnForme As Style
    
    ' Spécifiez la plage de cellules dont vous souhaitez sauvegarder la mise en forme
    Set Plage = Range("A1:A10")
    
    ' Sauvegardez la mise en forme actuelle de la plage
    Set MaMiseEnForme = Plage.Style
    
    ' Modifiez la mise en forme de la plage (par exemple, changez la couleur de fond)
    Plage.Interior.Color = RGB(255, 0, 0) ' Rouge
    
    ' Pour restaurer la mise en forme d'origine plus tard
    ' Utilisez la mise en forme sauvegardée
    Plage.Style = MaMiseEnForme
End Sub

 

[Staple1600]

Re

@laurent950
Pour l'instant j'attends de savoir si @halecs93 (par curiosité) souhaite voir un truc avec le menu contextuel
Si oui, je retournerai dans mon VBE
Si non, je vais faire tout autre chose

Quand à ta question, la maison mère nous dit tout

Range.Style, propriété (Excel)

Rubrique de référence sur Office VBA

learn.microsoft.com

 

[laurent950]

Merci @Staple1600

Tu es très fort. j'arrête aussi la. je te souhaite une bonne fin de soirée et je te remercie pour le lien

Laurent

 

[halecs93]

Re

@laurent950
Pour l'instant j'attends de savoir si @halecs93 (par curiosité) souhaite voir un truc avec le menu contextuel
Si oui, je retournerai dans mon VBE
Si non, je vais faire tout autre chose

Quand à ta question, la maison mère nous dit tout

Range.Style, propriété (Excel)

Rubrique de référence sur Office VBA

learn.microsoft.com

Hello... je crois préférer la solution de Laurent... elle semble mieux correspondre à mes attentes. Mais grand merci aussi