✔ VBA Dashboards Specialist®: VBA Excel - Ordenando as Abas da sua Planilha - Sorting By Name And Ordering Worksheets In A Workbook

11 de outubro de 2013

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