Amélioration code Résolu/Fermé

Question

Bonjour, 

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").ActivateEnd Sub

En vous remerciant.

Configuration: Windows 7 / Excel 2003 / Firefox 42.0

gbinforme · Accepted Answer

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

vielhom · Answer

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.

Amélioration code

2 réponses

Discussions similaires