Arquivo da categoria: VBA

Dicas, modelos, exemplos da ferramenta que faz a grande diferença a suíte Microsoft Office

Excel VBA – Unindo dados de planilhas de arquivos diferentes

Nós primórdios dos vídeos para a internet (lá pra 2006), publiquei um tutorial sobre como unir o dados de várias planilhas em uma só fazendo uma “maracutaia” com SQL para conseguir a façanha. O tutorial foi divido em 3 partes que ainda constam como os vídeos mais assistidos do meu canal no youtube:

Em todos estes anos publicado, um dos pedidos mais frequentes era como estender a proeza a vários arquivos. Por fim, eis um resultado.

Vejam a macro abaixo:

Option Explicit
 
Private Function ListaArquivos(ByVal Caminho As String) As String()
 
'Atenção: Faça referência à biblioteca Micrsoft Scripting Runtime
Dim FSO As New FileSystemObject
Dim result() As String
Dim Pasta As Folder
Dim Arquivo As File
Dim Indice As Long
 
ReDim result(0) As String
If FSO.FolderExists(Caminho) Then
    Set Pasta = FSO.GetFolder(Caminho)
 
    For Each Arquivo In Pasta.Files
      Indice = IIf(result(0) = "", 0, Indice + 1)
      ReDim Preserve result(Indice) As String
      result(Indice) = Arquivo.Name
    Next
End If
 
ListaArquivos = result
ErrHandler:
    Set FSO = Nothing
    Set Pasta = Nothing
    Set Arquivo = Nothing
End Function
 
Public Sub UnirTodos()
On Error GoTo trata_saida:
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim arquivos() As String
    Dim lCtr As Long, processados As Long
    arquivos = ListaArquivos(ThisWorkbook.Path)
    For lCtr = 0 To UBound(arquivos)
        If ValidaNomeArquivo(arquivos(lCtr)) Then
            'Debug.Print arquivos(lCtr)
            Call UnirAoArquivo(arquivos(lCtr))
            processados = processados + 1
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox processados & " arquivos processados"
trata_saida:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Private Function ValidaNomeArquivo(ByVal nomeArquivo As String) As Boolean
    Dim result As Boolean
    result = InStr(1, nomeArquivo, ThisWorkbook.Name, vbTextCompare) = 0
    If result Then
        result = result Or Right(nomeArquivo, 4) = ".xls"
        result = result Or Right(nomeArquivo, 4) = "xlsx"
        result = result Or Right(nomeArquivo, 4) = "xlsm"
    End If
    ValidaNomeArquivo = result
End Function
 
Private Sub UnirAoArquivo(ByVal nomeArquivo As String)
On Error GoTo trata_erro_uniraoarquivo
    Dim wb As Workbook, ws As Worksheet, mySheet As Worksheet, rngCopy As Range
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & nomeArquivo, ReadOnly:=True)
    Set ws = wb.Worksheets(1)
    Set mySheet = ThisWorkbook.Worksheets(1)
    
    'seleciona a regiao com conteudo
    Set rngCopy = ws.Range(ws.Cells(2, 1), ws.Cells(ws.UsedRange.Rows.Count, ws.UsedRange.Columns.Count))
    'copia
    rngCopy.Copy
    'cola no destino
    With mySheet
        Call .Paste(.Cells(.UsedRange.Rows.Count + 1, 1))
    End With
    
    wb.Close
trata_saida_uniraoarquivo:
    Set wb = Nothing
    Set ws = Nothing
    Exit Sub
trata_erro_uniraoarquivo:
    GoTo trata_saida_uniraoarquivo:
End Sub

Em resumo:

  • A macro da chama principal é a UnirTodos
  • Ela usa a Sub ListaArquivos (já mostrada aqui no blog) para obter a lista de arquivos que existem na mesma pasta do arquivo com as macros.
  • No meio do processo, a Function ValidaNomeArquivo que retorna um Boolean (Verdadeiro/Falso) confere se o arquivo possui uma extensão de Excel válida, neste caso, xls, xlsx e xlsm e também se não é o próprio arquivo.
  • Para cada arquivo válido encontrado na lista, a Sub UnirAoArquivo
  • A Sub UnirAoArquivo recebe somente o nome do arquivo como parâmetro. Com isso, ela:
    • abre o arquivo
    • seleciona a primeira planiha deste arquivo (índice 1)
    • copia a área ocupada (usando a propriedade UserRange)
    • cola o conteúdo na primeira planilha do arquivo corrente (que contém a macro) na primeira linha não ocupada.

O processo é repetido para cada arquivo válido na pasta. A velocidade de execução depende da quantidade de arquivos na pasta e claro, do poder do computador em questão.

Não há requisito para a estrutura do arquivo, ou seja, não é preciso que todas as planilihas tenham a mesma estrutura de colunas e na mesma ordem. Entretanto, esse tipo de união faz mais sentido quanto essa regra é aplicada.

Bom proveito!

VBA – Preenchendo um listbox com mais de 10 colunas

Eis um tópico polêmico, como não poderia deixar de ser. E tem motivação melhor para gerar um artigo? Claro que não! Então vamos em frente!

Muitos que começam a explorar um pouco mais o uso do ListBox em seus formulários VBA percebe que ele tem muito mais a oferecer do que uma simples lista de dados. Pessoalmente, no VBA, eu uso ele como controle oficial até mesmo para grids. Os motivos eu explico outra hora.

Voltando ao assunto do título, muitos culpam o ListBox por ser um controle incompleto por ele não permitir adicionar mais de 10 colunas nele. Isso é verdade, mas também não é. Existe sim essa limitação, mas ela está atrelada ao como você coloca os dados no Listbox. Como tudo no mundo da programação, o melhor jeito de demonstrar isso é por um exemplo. Pois bem, considere a seguinte planilha:

VBA - Preenchendo um listbox com mais de 10 colunas

Aqui temos 10 colunas e algumas linhas. Sem enrolação, crie um userform, adicione um listbox nele (com uma largura suficiente para ver as colunas) e coloque o seguinte código:

Private Sub UserForm_Initialize()
    With Planilha1
        Me.ListBox1.ColumnCount = .UsedRange.Columns.Count
        For linha = 1 To .UsedRange.Rows.Count
            ListBox1.AddItem ""
            For coluna = 1 To .UsedRange.Columns.Count
                ListBox1.List(linha - 1, coluna - 1) = .Cells(linha, coluna)
            Next coluna
        Next linha
    End With
End Sub

Onde Planilha1 é o nome do objeto da sua planilha. Sem ir muito a fundo no código, ele faz dois laços For, um para as linhas da planilha e um para as colunas. A propriedade UsedRange define a área usada da planilha, ou seja, vai funcionar bem para planilha que só contenha dados como o exemplo.

Se rodar o codigo, o resultado será isso:

VBA - Preenchendo um listbox com mais de 10 colunas 2

O listbox funcionando. Lindo! Agora, vamos ao problema. Se adicionarmos mais uma coluna na nossa planlha, como mostra abaixo:

VBA - Preenchendo um listbox com mais de 10 colunas 3

Receberemos o seguinte erro:

VBA - Preenchendo um listbox com mais de 10 colunas 4

Se usado dessa forma, ou seja, adicionar itens através do método AddItem, o Listbox se limitará a no máximo 10 colunas.

Existem duas formas de contornar isso:

  1. Usar a propriedade RowSource (fuja!)
  2. Usar arrays (eba!)

Obviamente, vamos para a segunda. Sem alterar a planilha, altere o código do formulário para o seguinte:

Private Sub UserForm_Initialize()
    Dim arrayItems()
    With Planilha1
        ReDim arrayItems(1 To .UsedRange.Rows.Count, 1 To .UsedRange.Columns.Count)
        Me.ListBox1.ColumnCount = .UsedRange.Columns.Count
        For linha = 1 To .UsedRange.Rows.Count
            Me.ListBox1.AddItem
            For coluna = 1 To .UsedRange.Columns.Count
                arrayItems(linha, coluna) = .Cells(linha, coluna).Value
            Next coluna
        Next linha
        
        Me.ListBox1.List = arrayItems()
    End With
End Sub

Execute o formulário novamente e….

VBA - Preenchendo um listbox com mais de 10 colunas 5
Voilá! Um ListBox com mais de 10 colunas!

O que aconteceu? Ao invés de jogar os dados direto no listbox, alimento um array com os dados e depois jogo os dados no Listbox através da propriedade List. O ListBox é esperto para entender um Array, o que não é o caso do AddItem.  O Array, obviamente, tem as dimensões da área ocupada na planilha (mais uma vez , o UserRange é utilizado aqui).

É isso. Bom proveito!

Download do arquivo:

VBA – Preenchendo um listbox com mais de 10 colunas.zip (265.24 KiB)

VBA – EXEMPLO DE SETFOCUS E SAÍDA DO CONTROLE QUANDO ESTE ESTIVER VAZIO

Devido ao número de solicitações em referente a Propriedade Setfocus, ou como dizem, evitar de sair de um controle se ele estiver em branco, e geralmente utilizam somente o Evento EXIT, só que dependendo da estrutura, cria-se o inconveniente de quando o controle estiver em branco e clicar em um Botão para fechar o Formulário recebemos a mensagem que o preenchimento é obrigatório, só que não queremos preenche-lo no momento e sim somente fechar o formulário.

Baseando-me nestas solicitações montei um modelo onde utilizo um Frame e uma Variável para anular a Propriedade Cancel do Evento Exit, e aproveitei para deixar o textbox com aceitação só de numeros/ datas e somente texto.

Com certeza existem outras formas, mas a que eu geralmente utilizo é esta, então segue para quem precisar.

  • Userfom Eventos Exit – KeyPres – Change
  • Userform sem o “X” para fechar o formulário.
  • Controles somente Datas e Textos

Evento Exit - SetFocus

Download do arquivo

SetFocus Evento Exit.zip (74.64 KiB)

Post no fórum

http://www.tomasvasquez.com.br/forum/viewtopic.php?p=18978

Modelo – Mover Dados entre duas ComboBox´s ou ListBox´s

Boa tarde a todos!

Estou trazendo mais um modelo, utilizando os velhos controles ComboBox e ListBox.

Dessa vez, criei uma estrutura que nos possibilita pegar os dados de um desses dois controles e enviar para outro, conforme pode ser visto na imagem abaixo.

Tela com 2 ListBox.jpg
Tela Demostração

Espero que esse modelo possa ajudar aos colegas, em seus desenvolvimentos no dia a dia.

Excelente semana a todos e forte abraço.