EXCELer

João Pereira, num comentário a um post meu, formulou a seguinte questão:

"Tenho que fazer uma macro que copie a coluna que estiver indicada na célula A1 e colar numa nova planilha.

Exemplo: Se na célula A1 conter o dado "B", então a Macro vai copiar a coluna B e colar numa outra planilha...

Como devo fazer para que isso ocorra?"


Bom, uma resposta possível, será, tomando o exemplo acima descrito:

1º - cria-se um botão de comando na Sheet1, e atribui-se-lhe o código adequado à resolução:



2º clica-se no botão de comando para executar o código:



3º o resultado será, na Sheet2:



O Código:

Private Sub CommandButton1_Click()
    Dim strNome As String

    strNome = Range("A1").Value
    strNome = strNome & ":" & strNome
    Me.Range(strNome).Copy
    Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues, _
                                              Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

Por vezes temos interesse em que não seja possível aceder às diferentes folhas de um workbook através dos respectivos tabuladores. Para isso, temos que nos socorrer de um pouco de código para conseguirmos esse efeito.

Exemplo:



Acedemos então ao Editor de VBE, clicando no icone do workbook com a tecla direita do rato, para incluirmos o respectivo código no mesmo workbook:



Depois de inserirmos o código, salvamos o ficheiro. Ao ser aberto novamente, já não aparecerão os tabuladores das folhas:



O Código:

Private Sub Workbook_Open()
    Sheets("Sheet1").Activate
    ActiveWindow.DisplayWorkbookTabs = False
End Sub

Para desactivar uma tecla de função, podemos utilizar o seguinte Código:

Application.OnKey "{F3}", ""

Para activar novamente:

Application.OnKey "{F3}"

Se pretendermos abrir um determinado programa (no exemplo o programa Calc.exe, que abre a calculadora) através de uma tecla de função (v.g. F3):



Podemos utilizar o seguinte Código:

Sub Auto_Open()
    Application.DisplayAlerts = False
    Application.OnKey "{F3}", "ShowCalc"
    Application.DisplayAlerts = True
End Sub

Sub ShowCalc()
    Shell "Calc.Exe", vbNormalFocus
End Sub

Para protegermos uma folha sem termos que recorrer a Ferramentas|Protecção|Proteger Folha, podemos utilizar uma Check Box e associá-la a um pouco de código, de modo a que, ao clicarmos nela, a folha fique protegida ou desprotegida.

Vejamos o resultado, em primeiro lugar:





Passemos agora ao desenvolvimento:
Criar a Check Box:



Depois de criarmos a Check Box, vamos associá-la com o seguinte Código:

Sub ProtegeSheet1()
'   Protege/Desprotege Folha
    If Sheets("Sheet1").CheckBoxes("cbProtectSheet").Value = xlOn Then
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True
    Else
        ActiveSheet.Unprotect
    End If
End Sub


Exemplo para efectuar a associação:

Nos dois posts anteriores, foi mostrado como se podem acrescentar dados a um comentário e como copiar o conteúdo desse comentário para uma nova folha.
Hoje mostro como se podem efectuar alterações num comentário múltiplo, como no exemplo:








O Código (adaptado do apresentado num forum sobre Excel, em 27-01-2005):

Sub AlterarNoComentario()
    Dim temp1 As String, temp2 As String, temp3 As String, temp4 As String
    ians1 = Application.InputBox("Localizar:", "Localizar & Substituir no Comentário ", "")
    ians2 = Application.InputBox("Substituir:", "Localizar & Substituir no Comentário ", "")
    temp3 = ians1
    temp4 = ians2
    For Each cell In Selection
        temp1 = cell.Comment.Text
        On Error Resume Next
        temp2 = Replace(temp1, temp3, temp4)
        cell.Comment.Text Text:=temp2
    Next
End Sub

No seguimento do post anterior, se pretendermos listar o conteúdo de todos os comentários e os respectivos endereços (células) numa nova worksheet:



podemos utilizar uma peça de código que foi mostrada por Debra Dalgleish.

O Código:

Sub ListComms()
    Dim cell As Range
    Dim sh As Worksheet
    Dim csh As Worksheet
    Set csh = ActiveWorkbook.Worksheets.Add
    csh.Name = "Comments"
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> csh.Name Then
            For Each cell In sh.UsedRange
                If Not cell.Comment Is Nothing Then
                    With csh.Range("a65536").End(xlUp).Offset(1, 0)
                        .Value = sh.Name & " " & cell.Address
                        .Offset(0, 1).Value = cell.Comment.Text
                    End With
                End If
            Next cell
        End If
    Next sh
End Sub

Elaborado a partir de uma peça de código apresentada por David Hager em 01/11/1999:







O Código (adaptado):

Public acVal
Public allVal    ' adicionado

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    On Error Resume Next
    Target.AddComment
    Target.Comment.Text "O valor anterior foi: " & acVal & _
       vbLf & allVal ' modificado/adicionado
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    If ActiveCell.Address <> Target.Address Then Exit Sub
    If Target.Value = "" Then
        acVal = ""
        allVal = "" ' adicionado
    Else
        allVal = ActiveCell.Comment.Text ' adicionado
        acVal = Target.Value
    End If
End Sub

Se pretendermos somar determinadas ocorrências, como no exemplo (somar as ocorrências "Mário" e "Amadeu"):



podemos utilizar as Funções SUM() e COUNTIF():

=SUM(COUNTIF(A1:A6;{"*Mário*","*Amadeu*"}))

Nota: o asterisco (*) é um wildcard porque os nomes fazem parte de uma string que contém mais caracteres; os nomes são "case sensitive" ou seja, não é indiferente começarem por letra minúscula ou maiúscula.

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