EXCELer

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