XL 2016 erreur à la fermeture de mon userform

[halecs93]

Bonjour, ou bonsoir

Lorsque je ferme mon userform (bouton 'fermer'), je rencontre une erreur.

Excel indique "erreur d'exécution '13' : Incompatibilité de type"

Quelqu'un(e) aurait une solution ?

Merci

 

[halecs93]

Bonsoir... en effet l'erreur est bien signalée là. Mais mais maigres compétences ne me permettent pas de comprendre votre message. Merci

 

[Staple1600]

Bonsoir

Avec cet ajout dans la procédure Private Sub Worksheet_SelectionChange(ByVal Target As Range)
(qui se trouve sur la feuille SEM 1)

If Len(UserForm1.TextBox1.Value) Then ' ajout
        Target.Value = UserForm1.TextBox1.Value
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = CLng(UserForm1.TextBox1.Tag) ' Rouge
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
   End If ' fin ajout

Plus de message d'erreur

 

[halecs93]

Bonsoir

Avec cet ajout dans la procédure Private Sub Worksheet_SelectionChange(ByVal Target As Range)
(qui se trouve sur la feuille SEM 1)

If Len(UserForm1.TextBox1.Value) Then ' ajout
        Target.Value = UserForm1.TextBox1.Value
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = CLng(UserForm1.TextBox1.Tag) ' Rouge
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
   End If ' fin ajout

Plus de message d'erreur

Encore merci... j'ai ajouté cette procédure, mais je rencontre toujours cette erreur à la même ligne

 

[laurent950]

Bonsoir @halecs93

c'est corrigé même principe résolu et on passe au bornage

Dim FormatageLigne5 As Variant ' Variable pour stocker le formatage de la ligne 5


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim BoutonActive As Boolean
    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
              
                            Target.Value = UserForm1.TextBox1.Value
                            With Target.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
                            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
  
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
        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


'    Compte le nombre de cellules fusionnées dans la sélection
        CompteCellsFusionnéParLigne Range(Cells(Target.Row, 5), Cells(Target.Row, 69)), Target
      
        On Error GoTo 0
    End If
    ' Annuler le déclenchement du UserForm par défaut
    Cancel = True
End Sub


Private Sub CommandButton2_Click()
    Unload Me ' Fermer l'UserForm
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

Reste le format a remettre comme d'origine avant la défusion des cellules

Private Sub CommandButton2_Click()
        Unload UserForm1 ' Fermer l'UserForm si elle est ouverte
        ' Rétablir l'alignement par défaut
        ActiveCell.UnMerge
End Sub

 

[Staple1600]

Bonsoir @laurent950

Je n'ai pas dis que j'avais tout bon
mais qu'avec mon ajout, je n'avais plus de message d'erreur


Mon test s'est borné à :
clic sur Fermer alors que le TextBox1 est vide