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

[Orfelia]

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.

6

10

55

10

10

11

11

11

Merci à l'avance

J'utiliser Microsoft 365 pour Mac

 

[Gégé-45550]

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.

6

10

55

10

10

11

11

11

Merci à l'avance

J'utiliser Microsoft 365 pour Mac

Bonjour,
En supposant que la largeur voulue pour la colonne H est inscrite en H1 :

Columns("H:H").Select
Selection.ColumnWidth = Range("H1").Value

Cordialement,

 

[job75]

Bonjour Orfelia, Gégé-45550,

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+

 

[Orfelia]

Bonjour Orfelia, Gégé-45550,

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]

Bonjour Orfelia, le forum,

Il y a bug si un nombre est négatif ou supérieur à 255, il faut donc l'exclure :

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+

 

[Orfelia]

Bonjour à vous,

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

 

[job75]

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 :

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.

 

[Orfelia]

Il suffit d'ajouter un test pour que cette impossibilité ne concerne que la ligne 7 :

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]

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 :

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+

 

[Gégé-45550]

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,

 

[job75]

Bonjour le forum,

@Gégé-45550 les largeurs des colonnes ne sont pas forcément des nombres entiers.

Donc <256 ne va pas, il faut <=255.

A+

 

[job75]

En effet on peut mémoriser, cette solution utilise Application.Undo et un seul bouton Annuler :

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.