Microsoft 365 Ajuster la largeur des colonnes selon un chiffre inscrit dans une cellule

Orfelia

XLDnaute Nouveau
Bonjour,

Je cherche si c'est possible de modifier la largeur d'une colonne selon le chiffre inscrit dans une cellule,

Exemple, la largeur de chaque colonne s'ajusterait selon le chiffre dans une cellule sur une ligne spécifique.

610551010111111

Merci à l'avance

J'utiliser Microsoft 365 pour Mac
 

Pièces jointes

  • Test largeur automatique.xlsx
    32.3 KB · Affichages: 9

Gégé-45550

XLDnaute Accro
Bonjour,

Je cherche si c'est possible de modifier la largeur d'une colonne selon le chiffre inscrit dans une cellule,

Exemple, la largeur de chaque colonne s'ajusterait selon le chiffre dans une cellule sur une ligne spécifique.

610551010111111

Merci à l'avance

J'utiliser Microsoft 365 pour Mac
Bonjour,
En supposant que la largeur voulue pour la colonne H est inscrite en H1 :
VB:
Columns("H:H").Select
Selection.ColumnWidth = Range("H1").Value
Cordialement,
 

job75

XLDnaute Barbatruc
Bonjour Orfelia, Gégé-45550,
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
For Each c In Range("A7", Cells(7, Columns.Count).End(xlToLeft))
    If IsNumeric(CStr(c)) Then c.ColumnWidth = c
Next
End Sub
Modifiez ou validez une cellule quelconque.

A+
 

Pièces jointes

  • Test largeur automatique.xlsm
    36.3 KB · Affichages: 11

Orfelia

XLDnaute Nouveau
Bonjour Orfelia, Gégé-45550,
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
For Each c In Range("A7", Cells(7, Columns.Count).End(xlToLeft))
    If IsNumeric(CStr(c)) Then c.ColumnWidth = c
Next
End Sub
Modifiez ou validez une cellule quelconque.

A+
C'est exactement ce que je recherchais, merci mille fois pour la fonction et aussi pour la rapidité,
(j'me peu pu tellement chu contente)
 

job75

XLDnaute Barbatruc
Bonjour Orfelia, le forum,

Il y a bug si un nombre est négatif ou supérieur à 255, il faut donc l'exclure :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
For Each c In Range("A7", Cells(7, Columns.Count).End(xlToLeft))
    If IsNumeric(CStr(c)) Then If c >= 0 And c <= 255 Then c.ColumnWidth = c
Next
End Sub
A+
 

Pièces jointes

  • Test largeur automatique.xlsm
    36.5 KB · Affichages: 8

Orfelia

XLDnaute Nouveau
Bonjour à vous,

J'ai un petit soucis, je ne peux plus annuler quoi que ce soit lorsque le vba est actif.
1689536808428.png
 

job75

XLDnaute Barbatruc
J'ai un petit soucis, je ne peux plus annuler quoi que ce soit lorsque le vba est actif.
Il suffit d'ajouter un test pour que cette impossibilité ne concerne que la ligne 7 :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Intersect(Target, Rows(7)) Is Nothing Then Exit Sub
For Each c In Range("A7", Cells(7, Columns.Count).End(xlToLeft))
    If IsNumeric(CStr(c)) Then If c >= 0 And c <= 255 Then c.ColumnWidth = c
Next
End Sub
Si l'on modifie les largeurs de colonnes il faudra revalider une cellule en ligne 7.
 

Pièces jointes

  • Test largeur automatique.xlsm
    37.1 KB · Affichages: 9

Orfelia

XLDnaute Nouveau
Il suffit d'ajouter un test pour que cette impossibilité ne concerne que la ligne 7 :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Intersect(Target, Rows(7)) Is Nothing Then Exit Sub
For Each c In Range("A7", Cells(7, Columns.Count).End(xlToLeft))
    If IsNumeric(CStr(c)) Then If c >= 0 And c <= 255 Then c.ColumnWidth = c
Next
End Sub
Si l'on modifie les largeurs de colonnes il faudra revalider une cellule en ligne 7.
Merci de m'aider, mais j'ai toujours le même petit soucis, si je modifie quelque chose à la ligne 7 je comprends que c'est seulement pour c'est action que je ne peu plus annuler, mais automatiquement je perd l'historique des modification que j'aurais pu annuler, dès que je change une largeur de colonne. La seule façon est de récupérer une copie dans l'historique des versions, ce qui, selon moi n'est pas très pratique.
Alors est-ce que vous auriez une autre façon de contourner ce problème. Merci

Le contraire pour être aussi une alternative pour moi si je change manuellement la largeur des colonnes, alors, il serait ok de pouvoir voir s'afficher la valeur de la largeur, ce n'est pas l'idéal, mais c'est une alternative acceptable.

Merci
 

job75

XLDnaute Barbatruc
Bonjour Orfelia,

Avec le 1er problème je n'ai pas d'autre solution.

Pour l'alternative que vous proposez on peut utiliser cette macro :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
For Each c In UsedRange.Columns
    Cells(7, c.Column) = c.ColumnWidth
Next
End Sub
Mais là aussi il est impossible d'annuler.

A+
 

Pièces jointes

  • Test largeur automatique(1).xlsm
    36.7 KB · Affichages: 4

Gégé-45550

XLDnaute Accro
Merci de m'aider, mais j'ai toujours le même petit soucis, si je modifie quelque chose à la ligne 7 je comprends que c'est seulement pour c'est action que je ne peu plus annuler, mais automatiquement je perd l'historique des modification que j'aurais pu annuler, dès que je change une largeur de colonne. La seule façon est de récupérer une copie dans l'historique des versions, ce qui, selon moi n'est pas très pratique.
Alors est-ce que vous auriez une autre façon de contourner ce problème. Merci

Le contraire pour être aussi une alternative pour moi si je change manuellement la largeur des colonnes, alors, il serait ok de pouvoir voir s'afficher la valeur de la largeur, ce n'est pas l'idéal, mais c'est une alternative acceptable.

Merci
Bonsoir,
Une proposition avec deux boutons 'Ajuster' et 'Restaurer', le second s'affichant lorsque le premier a été activé et disparaissant à nouveau dès que lui-même a été activé.
Ce second bouton restaure la situation sur 100 lignes et 100 colonnes (à ajuster au besoin) telle qu'elle était au moment où le bouton 'Ajuster' a été activé.
en dehors de l'utilisation des boutons, l'historique des modifications est actif.
[EDIT]Code rectifié pour tenir compte de l'excellente remarque de job75 dans le post #11[/EDIT]
Cordialement,
 

Pièces jointes

  • Test largeur automatique.xlsm
    54.9 KB · Affichages: 4
Dernière édition:

job75

XLDnaute Barbatruc
En effet on peut mémoriser, cette solution utilise Application.Undo et un seul bouton Annuler :
VB:
Dim memValeur, memLargeur 'mémorise les variables

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%, c As Range
If Intersect(Target, Rows(7)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Application.Undo 'annule les modifications
'---mémorisations---
memValeur = Range("A7", Cells(7, Columns.Count).End(xlToLeft)).Value
ReDim memLargeur(1 To Application.CountA(memValeur))
For i = 1 To UBound(memLargeur)
    memLargeur(i) = Cells(7, i).ColumnWidth
Next
Application.Undo 'rétablit les modifications
Application.EnableEvents = True 'réactive les évènements
For Each c In Range("A7", Cells(7, Columns.Count).End(xlToLeft))
    If IsNumeric(CStr(c)) Then If c >= 0 And c <= 255 Then c.ColumnWidth = c
Next
End Sub

Sub Annuler()
Dim Valeur, Largeur(), i%, c As Range
If Not IsArray(memLargeur) Then Exit Sub
'---mémorisations temporaires---
Valeur = Range("A7", Cells(7, Columns.Count).End(xlToLeft)).Value
ReDim Largeur(1 To Application.CountA(Valeur))
For i = 1 To UBound(Largeur)
    Largeur(i) = Cells(7, i).ColumnWidth
Next
'---annulation---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Rows(7) = Empty 'RAZ
[A7].Resize(, Application.CountA(memValeur)) = memValeur
For i = 1 To UBound(memLargeur)
    If memLargeur(i) >= 0 And memLargeur(i) <= 255 Then Cells(7, i).ColumnWidth = memLargeur(i)
Next
Application.EnableEvents = True 'réactive les évènements
'---nouvelles mémorisations---
memValeur = Valeur
ReDim memLargeur(1 To Application.CountA(memValeur))
For i = 1 To UBound(memLargeur)
    memLargeur(i) = Largeur(i)
Next
End Sub
On peut re-cliquer sur le bouton pour annuler l'annulation précédente.

Edit : ajouté le test If Not IsArray(memLargeur) Then Exit Sub dans la macro Annuler.
 

Pièces jointes

  • Test largeur automatique(2).xlsm
    41.4 KB · Affichages: 5
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
313 261
Messages
2 096 638
Membres
106 695
dernier inscrit
Patou85