VBA Excel - Ordenando as Abas da sua Planilha - Sorting By Name And Ordering Worksheets In A Workbook

Consultancy in Excel, Access, VBA & PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

Pois é, estamos na versão 2013 da maior suíte de trabalho voltada para escritórios e ela ainda não contempla um mecanismo ou comando para ordenar as planilhas (sheets) dentro de um arquivo (workbook).

Com esta função, você pode classificar algumas ou todas as planilhas pelo nome, em qualquer ordem crescente ou decrescente.

Este código consiste em uma função que usa parâmetros para controlar o comportamento. Você precisa criar alguns procedimentos que levam as planilha à classificação.

ORDENANDO POR NOME

Public Function SortWorksheetsByName(ByVal FirstToSort As Long, _

                            ByVal LastToSort As Long, _

                            ByRef ErrorText As String, _

                            Optional ByVal SortDescending As Boolean = False, _

                            Optional ByVal Numeric As Boolean = False) As Boolean

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' SortWorksheetsByName

' This sorts the worskheets from FirstToSort to LastToSort by name

' in either ascending (default) or descending order. If successful,

' ErrorText is vbNullString and the function returns True. If

' unsuccessful, ErrorText gets the reason why the function failed

' and the function returns False. If you include the Numeric

' parameter and it is True, (1) all sheet names to be sorted

' must be numeric, and (2) the sort compares names as numbers, not

' text.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim M As Long

Dim N As Long

Dim WB As Workbook

Dim B As Boolean

Set WB = Worksheets.Parent

ErrorText = vbNullString

If WB.ProtectStructure = True Then

    ErrorText = "Workbook is protected."

    SortWorksheetsByName = False

End If

    

'''''''''''''''''''''''''''''''''''''''''''''''

' If First and Last are both 0, sort all sheets.

''''''''''''''''''''''''''''''''''''''''''''''

If (FirstToSort = 0) And (LastToSort = 0) Then

    FirstToSort = 1

    LastToSort = WB.Worksheets.Count

Else

    '''''''''''''''''''''''''''''''''''''''

    ' More than one sheet selected. We

    ' can sort only if the selected

    ' sheet are adjacent.

    '''''''''''''''''''''''''''''''''''''''

    B = TestFirstLastSort(FirstToSort, LastToSort, ErrorText)

    If B = False Then

        SortWorksheetsByName = False

        Exit Function

    End If

End If

If Numeric = True Then

    For N = FirstToSort To LastToSort

        If IsNumeric(WB.Worksheets(N).Name) = False Then

            ' can't sort non-numeric names

            ErrorText = "Not all sheets to sort have numeric names."

            SortWorksheetsByName = False

            Exit Function

        End If

    Next N

End If

'''''''''''''''''''''''''''''''''''''''''''''

' Do the sort, essentially a Bubble Sort.

'''''''''''''''''''''''''''''''''''''''''''''

For M = FirstToSort To LastToSort

    For N = M To LastToSort

        If SortDescending = True Then

            If Numeric = False Then

                If StrComp(WB.Worksheets(N).Name, WB.Worksheets(M).Name, vbTextCompare) > 0 Then

                    WB.Worksheets(N).Move before:=WB.Worksheets(M)

                End If

            Else

                If CLng(WB.Worksheets(N).Name) > CLng(WB.Worksheets(M).Name) Then

                    WB.Worksheets(N).Move before:=WB.Worksheets(M)

                End If

            End If

        Else

            If Numeric = False Then

                If StrComp(WB.Worksheets(N).Name, WB.Worksheets(M).Name, vbTextCompare) < 0 Then

                    WB.Worksheets(N).Move before:=WB.Worksheets(M)

                End If

            Else

                If CLng(WB.Worksheets(N).Name) < CLng(WB.Worksheets(M).Name) Then

                    WB.Worksheets(N).Move before:=WB.Worksheets(M)

                End If

            End If

        End If

    Next N

Next M

SortWorksheetsByName = True

End Function

Tags: VBA, excel, 

Sorting, Name, Ordering, Worksheets, Workbook

Reference: CPerson