EXCELer

Como pode ser facilmente observado, se mudarmos o nome da folha, por exemplo, de SHEET1 para TESTE01, nada acontece na célula que contém a função =NomeLF("F"), ou seja, a célula não é actualizada, apesar da alteração efectuada.
A maneira mais prática de "provocar" essa actualização, de um modo mais ou menos automático, é incluir no código a instrução Application.Volatile, porque o Excel não consegue determinar que é necessário efectuar o recálculo para actualizar a folha.

O Código:

Option Explicit

Public Function NomeLF(strChoice As String) As String
    Dim livro As String
    Dim folha As String
    Application.Volatile ' Esta é a nova linha
    If strChoice = "L" Then
        livro = ActiveWorkbook.Name
        NomeLF = livro
    ElseIf strChoice = "F" Then
        folha = ActiveSheet.Name
        NomeLF = folha
    Else
    End If
End Function

Às vezes temos necessidade de colocar numa célula o nome do livro activo ou da folha activa. Para isso, podemos construir uma UDF para cada situação, a que chamaremos NomeLivro() e NomeFolha(), respectivamente:



Os Códigos:

Public Function NomeLivro()
    Dim livro As String
    livro = ActiveWorkbook.Name
    NomeLivro = livro
End Function

Public Function NomeFolha()
Dim folha As String
folha = ActiveSheet.Name
NomeFolha = folha
End Function


No entanto, se formos um pouco mais elaborados, podemos concentrar ambas as situações numa só UDF, a que chamaremos, p. ex., NomeLF(), sendo que que a sintaxe da Função será, para o livro, NomeLF("L") e para a folha, NomeLF("F"):



O Código:

Option Explicit

Public Function NomeLF(strChoice As String) As String
    Dim livro As String
    Dim folha As String
    If strChoice = "L" Then
        livro = ActiveWorkbook.Name
        NomeLF = livro
    ElseIf strChoice = "F" Then
        folha = ActiveSheet.Name
        NomeLF = folha
    Else
    End If
End Function

Normalmente, quando pretendemos colocar um hyperlink numa determinada célula, escrevemos o endereço na mesma:



No entanto, se quisermos personalizar um pouco, podemos escrever o que entendermos e depois efectuar a inserção do endereço:





Como é fácil verificar, o comentário que aparece mostra o endereço.

Contudo, se quisermos que este comentário também esteja personalizado, podemos optar por inserir o hyperlink do seguinte modo:




O resultado será:

No post anterior, mostrei a utilização da função SUMPRODUCT(). Hoje, para o mesmo exemplo, mostro uma outra via para o mesmo resultado, com a utilização da função SUM(), mas utilizando um Array:



Nota: para a obtenção do Array, ou seja, das chavetas que indicam tratar-se de um Array, utilizar as teclas Ctrl + Shift + Enter.
Nota: sobre a Função SUM() utilizado em Array, ver o meu post de 23-01-2005

Se pretendermos "contar" uma determinada ocorrência, mas que obedeça, por exemplo a um critério, podemos utilizar a Função SUMPRODUCT() ou SOMARPRODUTO().
No exemplo, pretendemos contar o número de vezes em que o nome "joão" aparece na coluna A, obedecendo ao critério de lhe corresponder o algarismo 2 na coluna B:

Utilizando o Código do post anterior com uma pequena alteração, podemos adicionar mais um pouco de código para tentar simular um blink entre o negro e o encarnado no conteúdo da Label:








O Código:

Option Explicit


Private Sub UserForm_Initialize()
    Dim dblTotal As Double
    Dim strTotal As String

    strTotal = Worksheets("Sheet1").Range("A7").Value
    dblTotal = Worksheets("Sheet1").Range("B7").Value
    Me.Label1.Caption = strTotal & " " & dblTotal

End Sub



Private Sub UserForm_Activate()
    Dim iCtr As Long
    For iCtr = 1 To 20
        Me.Label1.ForeColor = &HFF&
        Me.Repaint
        Call Sleep(100)
        Me.Label1.ForeColor = &H80000008
        Me.Repaint
        Call Sleep(100)
    Next iCtr
End Sub


ATENÇÃO - Num módulo à parte, adicionar o seguinte Código:

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


O Código para o blink, foi adaptado do Código mostrado por Dave Peterson num Fórum de Discussão sobre Excel

Se pretendermos que um determinado resultado apareça numa label dentro de um UserForm, como no exemplo, utilizamos um pouco de VBA, para obtermos o fim em vista:



O Código:

Private Sub UserForm_Initialize()
    Dim strTotal As Double

    strTotal = Worksheets("Sheet1").Range("B7").Value
    Me.Label1.Caption = strTotal
End Sub

Se pretendermos guardar um determinado ficheiro de Excel com o mesmo nome ou nome diferente, mas com a inclusão de uma determinada palavra (no exemplo a palavra é "FINAL_"), ficando o ficheiro protegido (read-only), podemos utilizar um pouco de VBA num botão de comando:



O Código:

Private Sub VersãoFinal_Click()
    Dim strNome, UserChoice, strGuarda As String

    Range("AB44") = "Final_"
    strNome = ThisWorkbook.Name

    strGuarda = InputBox("Digite o Nome do Ficheiro para Guardar ou OK para aceitar", , strNome)
    UserChoice = MsgBox("Quer mesmo gravar?", vbYesNo + vbQuestion)
    Select Case UserChoice
    Case vbNo
        Exit Sub
    Case Else
        ActiveWorkbook.SaveAs Filename:= _
                              Range("AB44").Value & strGuarda, FileFormat:=xlNormal, _
                              Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _
                              CreateBackup:=False
    End Select
End Sub

É possível centrar texto numa MsgBox:



O Código:

Function Msg(ParamArray parm())
    For a = LBound(parm) To UBound(parm)
        If Len(parm(a)) > max_len Then
            max_len = Len(parm(a))
        End If
    Next a
    For a = LBound(parm) To UBound(parm)
        If Len(parm(a)) < max_len Then
            spaces = (((max_len - Len(parm(a))) / 1.6))
            For b = 1 To spaces
                parm(a) = " " & parm(a) & " "
            Next b
        End If
        msgstring = msgstring & parm(a) & Chr(10)
    Next a
    MsgBox msgstring
End Function

Sub Testar_Msg()
a = Msg("Esta é uma frase que está na 1ª linha;", "Esta está na segunda;", _
    "Esta encontra-se na terceira linha", _
    "e esta na 4ª, mas a mensagem está toda centrada!")
End Sub


Nota - este código, agora adaptado, apareceu num Newsgroup de Excel pela mão de Paul Anthony (1998).

Se pretendermos que seja aberto um procedimento quando uma determinada célula recebe um valor diferente de 0 (zero) e apresente uma mensagem de alerta quando recebe um valor 0 (zero) , como no exemplo com a célula B4, podemos utilizar o Evento SelectionChange:





O Código:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If IsEmpty(Range("B4")) Then
        Exit Sub
    End If

    If Range("B4") <> 0 Then
        Call Test
    ElseIf Range("B4") = 0 Then
        MsgBox "A célula tem um valor 0 (zero)!"
    Else
        Exit Sub
    End If
    Range("B4").ClearContents
End Sub


Sub Test()
    MsgBox "Aqui pode ser colocado um procedimento porque o valor de B4 é <> de 0"
End Sub

Para colocar a data corrente (ou outra) numa determinada célula, podemos utilizar um pouco de VBA:



O Código:

Sub Colocar_Data()

    Dim Ops(1 To 3) As String
    Dim Msg As String
    Ops(1) = Day(Date)
    Ops(2) = Month(Date)
    Ops(3) = Year(Date)
    Msg = Ops(3) & "-" & Ops(2) & "-" & Ops(1)

    Range("C1").Select
    Application.Cursor = xlNormal
    ActiveCell.FormulaR1C1 = InputBox(Prompt:="Colocar Data (aaaa-mm-dd):", _
                                      Title:="Date", Default:=Msg)

End Sub


NOTA: Por defeito, a InputBox contém a data do dia [Default:=Msg]

Se quisermos, em vez de criarmos uma ListBox na própria Worksheet, podemos criá-la num UserForm. Vejamos o exemplo:



Usamos o mesmo tipo de InputBox, já mostrado anteriormente:



O resultado será:



Para aparecer a ListBox, temos então que criar um UserForm no editor de VBA, como o que segue:



Depois, inserimos a ListBox no UserForm:



Por fim, nas propriedades da ListBox, inserimos em RowSource o seguinte:




O Código:

- Para o UserForm:

Private Sub UserForm_Initialize()
Dim rng As Range
    Dim strProc As String
    
    On Error Resume Next
    
    Sheets("Sheet2").Columns(1).ClearContents

    With Sheets("Sheet1")
        strProc = InputBox("Digite a(s) letra(s) pretendidas e asterisco [ex. Jo*]ou asterisco para todos")
        Range("A:A").Select
        Selection.AutoFilter
        Selection.AutoFilter Field:=1, Criteria1:=strProc, Operator:=xlAnd
        Selection.Copy
        ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("A:A")
        Range("A1").Select
        Selection.AutoFilter
    End With

    With Sheets("Sheet2")
        Set rng = .Range(.Cells(2, 2), .Cells(Rows.Count, 1).End(xlUp))
    End With

End Sub


- Para o Botão de Comando:

Private Sub CommandButton1_Click()
    UserForm1.Show
End Sub

Se pretendermos que o(s) nome(s) filtrados apareçam numa ListBox na WorkSheet, criam-se: uma ListBox e um botão de comando, ambos a partir do Control ToolBox. Depois, com um pouco de VBA, podemos efectuar o filtro, como nos mostra a seguinte sequência:

1º - Para chamar o procedimento:



2º - Define-se o filtro:



3º - O resultado será:




O Código:

Private Sub CommandButton1_Click()

    Dim rng As Range
    Dim strProc As String
    
    On Error Resume Next
    
    Sheets("Sheet2").Columns(1).ClearContents

    With Sheets("Sheet1")
        strProc = InputBox("Digite a(s) letra(s) pretendidas e asterisco [ex. Jo*]ou asterisco para todos")
        Range("A:A").Select
        Selection.AutoFilter
        Selection.AutoFilter Field:=1, Criteria1:=strProc, Operator:=xlAnd
        Selection.Copy
        ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("A:A")
        Range("A1").Select
        Selection.AutoFilter
    End With

    With Sheets("Sheet2")
        Set rng = .Range(.Cells(2, 2), .Cells(Rows.Count, 1).End(xlUp))
    End With

    Sheets("Sheet1").ListBox1.List = rng.Value

End Sub


NOTA: como se pode verificar, é utilizada uma segunda Sheet (Sheet2) para onde passa o filtro, o qual, por sua vez, alimenta a ListBox. Sempre que se efectua um novo filtro, o conteúdo da coluna 1 da Sheet2 é apagado, conforme mostra o procedimento, logo no seu início, com o código     Sheets("Sheet2").Columns(1).ClearContents

No seguinte exemplo, temos uma tabela de nomes:



Se pretendermos aplicar um filtro com utilização de um procedimento em VBA, teremos



O resultado será:



Para desfazer o filtro, podemos utilizar novamente o mesmo procedimento em VBA, desta vez só com a utilização do wildcard "*" (asterisco) :



O resultado será o aparecimento da tabela, de novo já sem filtro efectuado:



O Código do exemplo:

Sub Procura()

Dim strProc As String

strProc = InputBox("Digite a(s) letra(s) pretendidas e asterisco [ex. Jo*]ou asterisco para todos")

Range("A:A").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=strProc, Operator:=xlAnd
Range("A1").Select

End Sub


Nota: o procedimento aceita quer o wildcard "*", como o "?"

Por vezes, podemos ter necessidade de limpar o conteúdo de determinadas células que se encontram desprotegidas numa worksheet com protecção, para termos a possibilidade de as preencher novamente com novos valores:



O resultado obtido por clicar no botão de comando "Limpar Entradas" será a limpeza das células B1:B3 e B5:B7 :



O Código:

Private Sub CommandButton1_Click()

    For Each Cell In ActiveSheet.UsedRange

        If Not Cell.Locked Then
            If Cell.Value <> "" Then
                Cell.ClearContents
            End If
        End If
    Next Cell

End Sub