• +351 91 33 888 29
    • clico@clico.pt

    Category Archive ordenar

    Ordenar Folhas Excel de forma Automatizada (Macro)

    Pretende-se com esta macro Ordenar as Folhas de um livro de Excel de forma ascendente.

    Video que mostra como fazer:

     

    Código:

    Option Explicit
    Sub OrdenarFolhas()
    ‘Esta rotina coloca as folhas de Excel por ordem ascendente

    Dim NomeFolhas() As String
    Dim ContarFolhas As Long
    Dim i As Long
    Dim AntigaFolhaActiva As Object

    ‘Se não houver folha activa
    If ActiveWorkbook Is Nothing Then Exit Sub

    ‘Verifica se a estrutura do livro esta protegida, se sim, não consegue ordenar e
    ‘devolve uma mensagem ao utilizador
    If ActiveWorkbook.ProtectStructure Then
    MsgBox ActiveWorkbook.Name & ” está protegida, “, vbCritical, “Não é possivel ordenar as folas. “
    Exit Sub

    End If

    ‘Verifica se o utilizador quer mesmo fazer a ordenação
    If MsgBox(“Pretende ordenar as folhas deste livro de Excel?”, vbQuestion + vbOKCancel) <> vbOK Then Exit Sub

    ‘Desactiva o CTRL+BREAK (opção cancelar)
    Application.EnableCancelKey = xlDisabled

    ‘Vai buscar o numero de folhas existentes
    ContarFolhas = ActiveWorkbook.Sheets.Count

    ‘Redimensiona a Array
    ReDim NomeFolhas(1 To ContarFolhas)

    ‘Armazena uma referência da folha activa
    Set AntigaFolhaActiva = ActiveSheet

    ‘Preenche a array com os nomes das folhas
    For i = 1 To ContarFolhas
    NomeFolhas(i) = ActiveWorkbook.Sheets(i).Name
    Next i

    ‘Coloca a array na ordem ascendente
    Call BubbleSort(NomeFolhas)

    ‘Desactiva a actualização de ecran
    Application.ScreenUpdating = False

    ‘Move/Ordenas as folhas
    For i = 1 To ContarFolhas
    ActiveWorkbook.Sheets(NomeFolhas(i)).Move _
    before:=ActiveWorkbook.Sheets(i)
    Next i

    ‘Reactiva a folha original
    AntigaFolhaActiva.Activate

    End Sub

    Sub BubbleSort(List() As String)
    ‘Função criada para ordenar as folhas e que é chamada em cima

    Dim primeiro, Ultimo As Long
    Dim i, j As Long
    Dim Temp As String

    primeiro = LBound(List)
    Ultimo = UBound(List)

    For i = primeiro To Ultimo – 1
    For j = i + 1 To Ultimo
    If List(i) > List(j) Then
    Temp = List(j)
    List(j) = List(i)
    List(i) = Temp
    End If
    Next j
    Next i
    End Sub

    Show Buttons
    Hide Buttons