Arquivo da tag: VBA

Excel VBA – Remover linhas duplicadas

A macro abaixo exclui na coluna selecionada as linhas que tiverem valores repetidos. Praticamente igual a função de filtro para registros exclusivos, só que em VBA. Copie o código e cole em um novo módulo VBA. Preenche em qualquer planilha uma lista com alguns valores repetidos. Clique Alt+F8 para ativar a macro e veja o resultado.

Public Sub ExcluirLinhasDuplicadas()
 
    Dim Col As Integer
    Dim r As Long
    Dim C As Range
    Dim N As Long
    Dim V As Variant
    Dim Rng As Range
 
    On Error GoTo EndMacro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    Col = ActiveCell.Column
 
    If Selection.Rows.Count > 1 Then
        Set Rng = Selection
    Else
        Set Rng = ActiveSheet.UsedRange.Rows
    End If
 
    N = 0
    For r = Rng.Rows.Count To 1 Step -1
        V = Rng.Cells(r, 1).Value
        If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
            Rng.Rows(r).EntireRow.Delete
            N = N + 1
        End If
    Next r
 
EndMacro:
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
End Sub

Fonte: http://vbamacros.blogspot.com/

VBA – Verificar conexão com a Internet

Internet Connection

Método simples para verificar se o computador está ou não conectado a Internet por VBA.

Copie e cole o seguinte código em um módulo VBA:

Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" _
                                                     (ByRef lpdwFlags As Long, _
                                                      ByVal lpszConnectionName As String, _
                                                      ByVal dwNameLen As Integer, _
                                                      ByVal dwReserved As Long) _
                                                      As Long
 
Dim sConnType As String * 255
 
Sub TesteConexaoInternet()
    Dim Ret As Long
    Ret = InternetGetConnectedStateEx(Ret, sConnType, 254, 0)
    If Ret = 1 Then
        MsgBox "Você está conectado a Internet via " & sConnType, vbInformation
    Else
        MsgBox "Você não está conectado a Internet", vbInformation
    End If
End Sub

A chamada retorna uma mensagem que avisa se existe conexão com a Internet e através de qual conexão ela é feita.

Abraços

Tomás

VBA – Criando Macros Simples e Úteis

O Microsoft Excel possibilita a automação de tarefas através de macros. Isso não é novidade.

Quando o assunto é automatizar tarefas repetitivas ou um conjunto de tarefas, as macros resolvem o problema. Por isso, é sempre bom ter em mãos algumas macros prontas que geralmente facilitam nosso trabalho em diversas situações. Neste artigo, a idéia é demonstrar algumas que tentam resolver algumas dessas situações.

Zoom-In, Zoom-Out automatizado.

No Excel 2003, trocar o zoom da planilha nem sempre é a tarefa mais cômoda de se fazer. O único atalho disponível depende do mouse com o botão de scroll com a tecla Ctrl pressionada. Criaremos então duas macros. Uma que incrementa o zoom em 10% e outra que o diminui na mesma quantidade. Vamos aproveitar inclusive uma outra macro para configurar o zoom para seu valor padrão que é 100%.

Veja o código abaixo:

Public Sub ZoomIn()
    Dim maisZoom As Long
    maisZoom = ActiveWindow.Zoom
    maisZoom = maisZoom + 10
 
    If maisZoom <= 400 Then         ActiveWindow.Zoom = maisZoom     End If End Sub Public Sub ZoomOut()     Dim menosZoom As Long     menosZoom = ActiveWindow.Zoom     menosZoom = menosZoom - 10     If menosZoom >= 10 Then
        ActiveWindow.Zoom = menosZoom
    End If
End Sub
 
Public Sub ZoomPadrao()
    ActiveWindow.Zoom = 100
End Sub

Observação: Adicionalmente nas macros ZoomIn e ZoomOut, foram adicionadas verificações no valor que é atribuido à propriedade ActivateWindow.Zoom que reflete o Zoom da planilha, já que esse valor não pode ser menor que 10 ou maior que 400. Atribuir qualquer valor que estrapole estes limites geraria um erro na execução da Macro.

Para efetuar um teste idôneo, retorne ao Microsoft Excel e execute estas macros, clicando em Ferramentas->Macro->Macros ou clicando o atalho Alt+F8. A seguinte tela surgirá:

Selecione a macro ZooIn e clique no botão executar. Veja que o zoom da planilha foi aumentado em 10%. Execute-a novamente para confirmar o resultado.

Tente executar o mesmo procedimento, só que agora selecionando a macro ZoomOut.

Para terminar, termine executando a macro ZoomPadrao e verfique se o Zoom da planilha é colocado par ao valor 100%.
Com certeza toda essa operação ficaria mais fácil se não fosse necessário percorrer tantos passos, ou seja, abrir a caixa de diálogo de Macros, selecionar a Macro e logo em seguida clicar no botão executar. Felizmente, o Excel permite que você associe teclas de atallho para acelerar a execução de suas Macros. Para associar uma Macro a uma atalho, abra a caixa de diálogo de Macros (Alt+F8), selecione a Macro ZoomIn e logo em seguida clique no botão Opções para que a seguinte janela seja mostrada.

Essa tela permite que seja inserida uma combinação de teclas, obrigatóriamente iniciada pela tecla Ctrl para ser associada a execução de suas macros. Isso significa que com apenas uma combinação de teclas será possível invocar a execução de uma determinada Macro. Para efetuarmos um teste, nesta tela, com o cursor do mouse sobre a caixa de texto logo após o “Ctrl+” mantenha a tecla Shift pressionada e sem soltá-la, pressione a tecla M. O resultado deve ser parecido com a figura abaixo:

É aconselhável utilizar atalhos que sejam diferentes daquela já existentes no Excel como Ctrl+P ou Ctrl+A. pois estes serão substituídos por estes novos.

Foi adicionada também uma descrição para fazer referência ao funcionamento da Macro ZoomIn. Clique em OK para voltar à caixa de diálogo de Macros nela, clique no botão fechar.

Com a janela do Microsoft Excel ativa, pressione o atalho Ctrl+Shift+M (para facilitar, mantenha pressionada as teclas Ctrl e Shift e aperte a tecla M sem soltar as duas anteriores) e confira o funcionamento da Macro. Para efetuar o mesmo procedimento para as outras Macros, adicione os atalhos Ctrl+Shift+N para a Macro ZoomOut Ctrl+Shift+P para a Macro ZoomPadrao.

O video para download disponível nesta página apresenta claramente a execução das macros através deste atalho.

Conclusão

Esta é apenas uma amostra do que pode ser feito para tornar algumas tarefas bem úteis bem fáceis de serem acessadas. Alguns exemplos comuns são uma macro para Salvar e Fechar automaticamente uma planilha, ou para importar dados de um arquivo, entre outras.

Com estes recursos em mãos, a criatividade é o limite.

VBA – Preenchendo um Listbox com valores únicos de uma lista

Fonte: http://www.exceltip.com

A macro abaixo preenche um ListBox (que também poderia ser um ComboBox) em um UserForm com os valores únicos de um range. No VBA, crie um UserForm, insira um ListBox e coloque o código abaixo.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Private Sub UserForm_Initialize()
    Dim MyUniqueList As Variant, i As Long
    With Me.ListBox1
        .Clear    ' limpa o conteúdo do listbox
        MyUniqueList = UniqueItemList(Range("A1:A30"), True)
        For i = 1 To UBound(MyUniqueList)
            .AddItem MyUniqueList(i)
        Next i
        .ListIndex = 0    ' seleciona o primeiro item
    End With
End Sub
 
Private Function UniqueItemList(InputRange As Range, _
                                HorizontalList As Boolean) As Variant
    Dim cl As Range, cUnique As New Collection, i As Long, uList() As Variant
    Application.Volatile
    On Error Resume Next
    For Each cl In InputRange
        If cl.Formula <> "" Then
            cUnique.Add cl.Value, CStr(cl.Value)
        End If
    Next cl
    UniqueItemList = ""
    If cUnique.Count > 0 Then
        ReDim uList(1 To cUnique.Count)
        For i = 1 To cUnique.Count
            uList(i) = cUnique(i)
        Next i
        UniqueItemList = uList
        If Not HorizontalList Then
            UniqueItemList = _
            Application.WorksheetFunction.Transpose(UniqueItemList)
        End If
    End If
    On Error GoTo 0
End Function

Neste caso, estou supondo que existe uma lista de valores entre as células A1 e A30 da planilha ativa. A função pode facilmente ser transformada para retornar um array com valores únicos.