Amélioration code
Résolu
vielhom
Messages postés
24
Statut
Membre
-
gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention -
gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Ce code a été effectué avec l'enregistreur de macros.
Peut-il être amélioré ?
En vous remerciant.
Ce code a été effectué avec l'enregistreur de macros.
Peut-il être amélioré ?
Private Sub CommandButton1_Click()
Columns("B:D").Select
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(5, 1)), TrailingMinusNumbers:= _
True
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").EntireColumn.AutoFit
Cells.Select
With Selection
.Hyperlinks.Delete
End With
Range("B1").Select
Range("A1:C200").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("A:C").Select
Range("C1").Activate
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.ColorIndex = 0
Columns("A:A").Select
Selection.NumberFormat = "000"
Range("A1").Activate
End Sub
En vous remerciant.
2 réponses
-
Bonjour,
Pas facile sans savoir ce que tu veux faire mais tu peux simplifier ainsi, a priori :Private Sub CommandButton1_Click() Columns("B:D").Insert Shift:=xlToRight Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(5, 1)), TrailingMinusNumbers:= _ True Columns("B").Delete Shift:=xlToLeft Columns("A:B").EntireColumn.AutoFit Columns("C").Delete Shift:=xlToLeft Columns("C").EntireColumn.AutoFit Cells.Hyperlinks.Delete Range("A1:C200").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal With Range("C1").Font .Underline = xlUnderlineStyleNone .ColorIndex = 0 End With Columns("A").NumberFormat = "000" Range("A1").Activate End Sub -
Bonjour gbinforme
Il s'agissait de mettre en ordre alphabétique une table des matières générées par Word.
Merci beaucoup, c'est parfait.
