Elargissement auto liste déroulante VBA

Bonjour,

Je souhaiterais automatiquement élargir une liste déroulante à la taille de son contenu pendant son utilisation.

Je précise que je suis sur une version Excel.2016. Par conséquent, la technique consistant à enregistrer préalablement la largeur de la colonne avant de procéder à la validation des données ne fonctionne pas après sauvegarde du fichier.

J'ai trouvé ce code sur le forum permettant d'élargir l'espace d'une liste déroulante (pratique pour les noms longs).

Il fonctionne mais il bogue. Dès que je sélectionne la feuille entière ou procède à des modifications. Le code plante et quelquefois fait planter le fichier.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False

Columns("B:G").ColumnWidth = 3

If Not Intersect(Range("B2:G6"), Target) Is Nothing And Target.Count = 1 Then

Columns(Target.Column).ColumnWidth = 20

End If

End Sub

Si quelqu'un a une solution corrective.

Merci à vous, bien cordialement

Bonjour,

tu pourrais ajouter cette condition à la macro,

If Target.Count > 1 Then Exit Sub

plutot,

If Target.Address = "$A$1:$XFD$1048576" Then Exit Sub

Merci à toi,

Mais j'ai beau essayer de placer cette condition, je ne peux plus sélectionner de cellule.

J'ai oublier de préciser que je suis un vrai bleu en VBA.

re,

essai comme ça,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$A$1:$XFD$1048576" Then Exit Sub
Columns("B:G").ColumnWidth = 3
If Not Intersect(Range("B2:G6"), Target) Is Nothing And Target.Count = 1 Then
Columns(Target.Column).ColumnWidth = 20
End If
End Sub

ça bogue encore lors de la sélection de la feuille.

Dommage,

re,

j'ai vérifié Target.Address sur ton fichier (ver 2016) et il n'est pas le même que sur ma version,

à tester,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Debug.Print Target.Address
If Target.Address = "$1:$1048576" Then Exit Sub
Columns("B:G").ColumnWidth = 3
If Not Intersect(Range("B2:G6"), Target) Is Nothing And Target.Count = 1 Then
Columns(Target.Column).ColumnWidth = 20
End If
End Sub

Ça fonctionne !

Impeccable,

Trop fort

Merci mille fois pour ton aide,

Super, Merci pour ce retour, au plaisir!