MACRO: Mise en forme automatique des colonnes

[luno123]

Bonjour tout le monde,

Ci-dessous mon code. J'ai un petit souci avec les colonnes nom et prénoms. La largeur de ces 2 colonnes ne permet pas aux contenus de s'afficher correctement. Donc une mise en forme automatique de ces 2 colonnes s'impose. J'ai trouvé un truc: en mettant un espace entre les guillemets et les mots "nom" ou "prénoms" comme vous pouvez le constater sur mon code.
Pensez-vous à une autre méthode plus esthétique?

Merci d'avance.

Luno




Sub AffecterSalariés()
Dim Collec As New Collection
Dim Cell As Range
Dim ITM As Byte
Application.ScreenUpdating = False
With Sheets("Salariés")
For Each Cell In .Range("B4:B" & .Range("B65536").End(xlUp).Row)
On Error Resume Next
Collec.Add (Cell), CStr(Cell)
On Error GoTo 0
Next
For ITM = 1 To Collec.Count

On Error Resume Next
Application.DisplayAlerts = False
Sheets(Collec(ITM)).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add
ActiveSheet.Name = Collec(ITM)
Range("A1") = " Nom "
Range("B1") = " Prénoms "
Range("C1") = "Salaire Brut"
Range("D1") = "Chges Pat."
Range("A1: D1").Interior.ColorIndex = 16
Range("F1:F1").Interior.ColorIndex = 8
Range("F1") = "Coût total des salaires"
Columns("A:C").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Next
For Each Cell In .Range("B4:B" & .Range("B65536").End(xlUp).Row)
Range(Cell.Offset(0, 2), Cell.Offset(0, 3)).Copy Destination:=Sheets(Cell.Value).Range("A" & Sheets(Cell.Value).Range("A65536").End(xlUp).Row + 1)
Cell.Offset(0, 6).Copy Destination:=Sheets(Cell.Value).Range("C" & Sheets(Cell.Value).Range("A65536").End(xlUp).Row)
Cell.Offset(0, 7).Copy Destination:=Sheets(Cell.Value).Range("D" & Sheets(Cell.Value).Range("A65536").End(xlUp).Row)
Sheets(Cell.Value).Range("G1") = Sheets(Cell.Value).Range("G1") + Cell.Offset(0, 6) + Cell.Offset(0, 7)
Next
End With
End Sub

 

[xyam]

Re : MACRO: Mise en forme automatique des colonnes

Salut le collègue Nantais

C'est les noms et prénoms des gens qui ne s'affiche pas en entier?

Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit

ce code execute les doubles cliques sur ta colonnes qui permet un ajustement de la largeur selon la valeur la plus longue

j'espère que ça t'aidera

 

[Guest]

Bonjour,

Si c'est simplement pour décaler le nom et le prénom de la bordure gauche de leur colonne tu peux faire:

Range("A1:B1").IndentLevel = 1

A+

 

[PrinceCorwin]

Re : MACRO: Mise en forme automatique des colonnes

Bonjour,

La fonction autofit gère la mise en largeur automatique de la colonne. Si tu n'as pas d'autres valeurs que nom et prenoms dans les deux colonnes, la largeur s'adaptera à ces valeurs.
Mais si par contre tu décales la fonction après l'ajour des données, l'auto élargissement des colonnes tiendra compte des données contenue dans les colonnes .
Si tu est sur plusieurs feuilles de données, tu peux certainement le faire en une seule fois

Sheets(1).Select
For i = 2 To Sheets.Count
Sheets(i).Select False
Next
Range("b:c").EntireColumn.AutoFit

CDLT

 

[luno123]

Re : MACRO: Mise en forme automatique des colonnes

@ XYAM

Il est déjà présent sur mon code ce que tu viens de me communiquer. Sauf si je ne l'ai pas bien situé?
Sinon oui les prénoms & noms ne s'affiche pas en entier car la largeur des colonnes est petite.

Sub AffecterSalariés()
Dim Collec As New Collection
Dim Cell As Range
Dim ITM As Byte
Application.ScreenUpdating = False
With Sheets("Salariés")
For Each Cell In .Range("B4:B" & .Range("B65536").End(xlUp).Row)
On Error Resume Next
Collec.Add (Cell), CStr(Cell)
On Error GoTo 0
Next
For ITM = 1 To Collec.Count

On Error Resume Next
Application.DisplayAlerts = False
Sheets(Collec(ITM)).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add
ActiveSheet.Name = Collec(ITM)
Range("A1") = "Nom"
Range("B1") = "Prénoms"
Range("C1") = "Salaire Brut"
Range("D1") = "Chges Pat."
Range("A1: D1").Interior.ColorIndex = 16
Range("F1:F1").Interior.ColorIndex = 8
Range("F1") = "Coût total des salaires"
Columns("A:C").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Next
For Each Cell In .Range("B4:B" & .Range("B65536").End(xlUp).Row)
Range(Cell.Offset(0, 2), Cell.Offset(0, 3)).Copy Destination:=Sheets(Cell.Value).Range("A" & Sheets(Cell.Value).Range("A65536").End(xlUp).Row + 1)
Cell.Offset(0, 6).Copy Destination:=Sheets(Cell.Value).Range("C" & Sheets(Cell.Value).Range("A65536").End(xlUp).Row)
Cell.Offset(0, 7).Copy Destination:=Sheets(Cell.Value).Range("D" & Sheets(Cell.Value).Range("A65536").End(xlUp).Row)
Sheets(Cell.Value).Range("G1") = Sheets(Cell.Value).Range("G1") + Cell.Offset(0, 6) + Cell.Offset(0, 7)
Next
End With
End Sub

 

[Guest]

Re,

Oui ou un mixte des deux. Faut voir...

A+

 

[xyam]

Re : Re: MACRO: Mise en forme automatique des colonnes

Re,
Pour moi la mise en forme se fait en dernier mais c'est juste mon avis,
et je ferais par colonne A:A et non A:C après ça ne change peut être pas
tiens nous au courant