Arquivo
Temporizador
Segue abaixo 3 exemplos de pausas.
1 – Este exemplo faz uma pausa na macro até chegar no horário do dia atual.
Application.Wait “18:23:00”
_____________________________________________________
2 – Este código para a macro por aproximadamente 10 segundos.
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
_____________________________________________________
3 – Este outro exemplo pausa a macro indicando por quanto tempo passou.
If Application.Wait(Now + TimeValue(“0:00:10”)) Then
MsgBox “Time expired”
End If
_____________________________________________________
Código retirados da fonte abaixo:
Fonte: http://msdn.microsoft.com/en-us/library/aa213656%28v=office.11%29.aspx
listbox
Preenchendo listbox com rowsource
Coloco abaixo duas maneiras, uma delas através do próprio vba (onde a fonte que postou está no final do texto) e a outra maneira através da propriedade do listbox no formulário.
Modo 1 – pelo VBA:
Sei que existe várias maneiras de preencher um listbox, mas coloco aqui um código que gostei pela forma simples e idéias agregadas que achei em pesquisas.
Link para download da planilha com código: clique aqui
Modo 2 – pela propriedade:
Agora se você deseja um preenchimento mais dinâmico do listbox, aconselho então à adicionar a propriedade no próprio listbox do formulário:
Fonte do modo1:
http://social.msdn.microsoft.com/Forums/pt-BR/vbapt/thread/0224bb64-a704-4c58-92e1-0355e6f9b3fe
Abraços
Bloquear Código VBA
Para colocar acesso restrito em seu código vba é bem simples.
Acessar o editor de código, ir em Ferramentas e clicar em Propriedades de VBAProject conforme imagem abaixo:
Em seguida, na próxima janela que abrir clicar na guia Proteção, marcar Bloquear projeto para exibição e digitar uma senha
Pronto seu código já está com mais segurança.
Alterar Célula Automaticamente sem botão
‘Este código deve ser inserido na plan1, não em módulos
‘Este código abaixo altera o conteúdo automaticamente da célula sem necessidade de ter um botão
‘Após inserir o número na célula A1 , irá exibir automaticamente na célula B1 o valor da célula A1 somando ele mesmo e dividindo por 2
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = “$A$1” Then
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value / 2
End If
End Sub
‘Agora basta usar sua criatividade e usar este recurso do jeito que mais lhe agrada
Consulta vba oracle com sql
Abaixo segue um código que muito me agrada! Não depender de criar uma fonte de dados ODBC para intermediar o banco e na e na própria planilha fazer consultas direto ao banco usando sql.
Eu uso uma base de dados oracle, mas também serve para base de dados access (.mdb).
Em ambos os casos (oracle ou access) é necessário adicionar a biblioteca ADO para conexão.
<<<<<ORACLE>>>>>
Private Sub cmdConexaoBD_Click()
Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer
‘define a conexão com o banco de dados
Set cn = New ADODB.Connection
cn.CursorLocation = adUseClient
cn.Open “Driver={Microsoft ODBC for Oracle}; ” & _
“CONNECTSTRING=database;uid=usuario;pwd=senha;”
‘define um novo objeto recordset (gravar resultado na variavel)
Set rs = New ADODB.Recordset
‘define a instrução sql
sql = “SELECT NOME, CODIGO FROM TA_SITUACOES”
‘gera o recordset para o sql sobre a conexao definida
rs.Open sql, cn
‘define o cabeçalho das células no excel
Range(“A1”).Value = “NOME”
Range(“B1”).Value = “CODIGO”
‘Retorno dos dados para excel, onde “i” é o contador e “EOF” fim dos dados
i = 1
If Not rs.EOF Then
Do While Not rs.EOF
Range(“A” & i + 1).Value = rs(0)
Range(“B” & i + 1).Value = rs(1)
rs.MoveNext
i = i + 1
Loop
End If
cn.Close
End Sub
_________________________________________________________________
<<<<<ACCESS>>>>>
Private Sub cmdConexaoBD_Click()
Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer
‘define a conexão com o banco de dados Northwind.mdb
Set cn = New ADODB.Connection
cn.ConnectionString = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:/teste/Northwind.mdb”
cn.Open
‘define um novo objeto recordset
Set rs = New ADODB.Recordset
‘define a instrução sql
sql = “SELECT Orders.CustomerID, Sum([Order Details].UnitPrice) AS ValorTotal, Sum([Order Details].Quantity) AS QuantidadeTotal”
sql = sql & ” FROM (Customers INNER JOIN Orders ON Customers.CustomerID = Orders.CustomerID)
sql = sql & ” INNER JOIN [Order Details] ON Orders.OrderID = [Order Details].OrderID”
sql = sql & ” GROUP BY Orders.CustomerID”
sql = sql & ” ORDER BY Orders.CustomerID”
‘gera o recordset para o sql sobre a conexao definida
rs.Open sql, cn
‘define o cabeçalho das células no excel
Range(“A1”).Value = “Codigo do Cliente”
Range(“B1”).Value = “Quantidade Total”
Range(“C1”).Value = “Valor total dos Pedidos”
i = 2
If Not rs.EOF Then
Do While Not rs.EOF
Range(“A” & i).Value = rs(0)
Range(“B” & i).Value = rs(2)
Range(“C” & i).Value = rs(1)
rs.MoveNext
i = i + 1
Loop
End If
cn.Close
End Sub
_______________________________________________________________
Fontes de pesquisa:
http://www.macoratti.net/vba_xls1.htm
http://social.msdn.microsoft.com/Forums/pt-BR/vbapt/thread/0a28ae49-98be-4ceb-84b8-cc80d925ddb9
Vídeo Recomendado:
Atualizar Tabela Dinâmica (sem botão)
‘ATUALIZA TODAS AS TABELAS DINÂMICAS EM UM SHEET (GUIA) QUANDO A TABELA DE DADOS FOR ALTERADA
‘Tabela de dados, conteúdo, deve estar na Plan1
‘O código VBA abaixo e a tabela dinâmica deve estar no mesmo sheet (no caso abaixo no Plan2)
‘desta maneira ao alterar os dados na Plan1, ao clicar no Plan2 irá atualizar automaticamente a tab. dinamica (Plan2)
_______________________________________________________
Private Sub Worksheet_Activate()
‘Lembrando que este código deve estar no Plan2
‘PivotTable1, é o nome da tabela dinâmica
Sheets(“Plan2”).PivotTables(“PivotTable1”).RefreshTable
End Sub
_________________________________________________
Alterar / copiar células automaticamente
Um código muito interessante, usando ele não é necessário criar botões de macro para alterar o conteúdo automaticamente das células.
Você deve colocar o código conforme imagem abaixo, ou seja não em módulos e sim nos sheets (pastas)
______________________________________________________
Ao alterar as células da coluna A as células da coluna B serão alteradas também.
Sub Worksheet_Change(ByVal Target As Range)
‘Ao alterar o conteúdo da célula A1 a célula B1 será alterada
If Target.Address = “$A$1” Then
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value / 2
End If
‘Abaixo é usado um Case para verificar várias células da coluna A
Select Case Target.Address
Case Is <= “$A$2”
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value / 2
Case Is <= “$A$3”
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value / 2
Case Is <= “$A$4”
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value / 2
End Select
End Sub
Verifica Versão do Office
‘Existe algumas discrepâncias de código entre o excel 2003 e 2007
‘Para isso vale usar um artifício simples que verifica versão do office
Sub VerificaVersaoExcel ()
If Application.Version = “12.0” Then
MsgBox “A versão do Excel é 2007.”
ElseIf Application.Version = “11.0” Then
MsgBox “A versão do Excel é 2003.”
ElseIf Application.Version = “8.0” Then
MsgBox “A versão do Excel é 97.”
End If
End Sub
Retirar Acentos / Letras Maiúsculas
‘O código abaixo retira vários acentos, você pode retirar alguns casos
‘ ou pode aproveitar ara substituir letras maiúsculas por minúsculas
Sub MacroSubstituindoAcentos()
Cells.Replace What:=”é”, Replacement:=”e”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=”É”, Replacement:=”E”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=”á”, Replacement:=”a”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=”Á”, Replacement:=”A”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=”Í”, Replacement:=”I”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=”Ó”, Replacement:=”O”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=”Ô, Replacement:=”A”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=”Ç”, Replacement:=”C”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=”Ú”, Replacement:=”U”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=”Ô”, Replacement:=”O”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=”Ê”, Replacement:=”E”, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=””, Replacement:=”A”, LookAt:=xlPart, SearchOrder:=xlByRows
End Sub
Conhecendo VBA 