Merci guillaume. Entre temps j'ai réussi à faire ce code et ça marche. Sub TriAuto() Dim Layout As AcadLayout Dim layouts As AcadLayout Dim SortLayoutRight As AcadLayout, SortLayoutLeft As AcadLayout Dim SortIt As New Collection Dim TabCount As Long, SortCount As Long, TabOrder As Long Dim TabName As String, SortText As String, msg As String Dim tempLayout As AcadLayout Dim AddedTab As Boolean ' Alphabetize internally For TabCount = 0 To (ThisDrawing.layouts.Count - 1) AddedTab = False TabName = ThisDrawing.layouts(TabCount).Name If TabName = "Model" Then GoTo SKIP ' Skip modelspace If SortIt.Count = 0 Then SortIt.Add TabName ' Add to beginning of list Else For SortCount = 1 To SortIt.Count ' Add to list by string SortText = SortIt(SortCount) If StrComp(TabName, SortText, vbTextCompare) = -1 Then If SortCount = 1 Then SortIt.Add TabName ' Add as first item Else SortIt.Add TabName, , SortCount ' Add as previous item End If AddedTab = True Exit For End If Next If Not (AddedTab) Then SortIt.Add TabName, , , SortIt.Count ' Add if we haven't yet End If SKIP: Next ' Write new AutoCAD tab order For SortCount = 1 To SortIt.Count Set tempLayout = ThisDrawing.layouts(SortIt(SortCount)) tempLayout.TabOrder = SortCount Next '------------------------------- ' Read and display New Tab Order '------------------------------- msg = "Classement Alphanumérique : " & vbCrLf & vbCrLf For TabCount = 0 To (ThisDrawing.layouts.Count - 1) TabName = ThisDrawing.layouts(TabCount).Name If TabName = "Model" Then GoTo SKIP2 ' Don't show modelspace TabOrder = ThisDrawing.layouts(TabCount).TabOrder msg = msg & "(" & TabOrder & ")" & vbTab & TabName & vbCrLf SKIP2: Next MsgBox msg, vbInformation End Sub
