Boa Tarde, tenho um código VBA que conectar a um banco de dados (ORACLE) me trás as informações que quero e ai a partir destas informações faço alguns gráfico as macros estão todas rodando, tem uma Do While Loop que fica rodando a cada um minuto e chama cada uma das minhas macros ....vou colocar aqui um código da atualização automatica e uma marcro que conecta no banco de dados...
Ao Abri a planilha executa isso e fica no Loop
Public Sub Workbook_Open()
Application.DisplayFullScreen = True
Application.DisplayFormulaBar = False
Sheets("METADIA").Range("B19").Value = Date
Sheets("METADIA").Range("C19").Value = Date
'Call ATUALIZACAO.ATUALIZACAO
NewH = Hour(Now)
NewM = Minute(Now) + 1
i = NewH & ":" & NewM
b = 1
Do While b = 1
NewH = Hour(Now)
NewM = Minute(Now)
Atual = NewH & ":" & NewM
Do While i = Atual
Sheets("METADIA").Range("B19").Value = Date
Sheets("METADIA").Range("C19").Value = Date
Call MUDAPLAN.MUDAGRAF
Call REFRESH.REFRESH
NewH = Hour(Now)
NewM = Minute(Now) + 1
i = NewH & ":" & NewM
DoEvents
Loop
'sem esse DoEvents não deixa mexer na planilha durante o processo tem de deixa ele ai
DoEvents
Loop
End Sub
O Loop vai Chamar a MUDAPLAN.MUDAGRAF que é isso
Sub MUDAGRAF()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim PP, SP, TP, QP As String
HI = "07:00"
PP = "09:29"
SP = "11:29"
TP = "15:19"
QP = "18:00"
newHour = Format(Now, "hh:mm")
'newMinute = Minute(Now)
HA = newHour
'Espera:
If HA >= HI And HA <= PP Then
Sheets("PRIMEIRAPARCIAL").Select
ActiveWindow.Zoom = 110
ElseIf HA <= SP Then
Sheets("SEGUNDAPARCIAL").Select
ActiveWindow.Zoom = 110
ElseIf HA <= TP Then
Sheets("TERCEIRAPARCIAL").Select
ActiveWindow.Zoom = 110
ElseIf HA <= QP Then
Sheets("GRAFICOMETADIA").Select
ActiveWindow.Zoom = 110
'DoEvents
'GoTo Espera
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Depois Vai chamar a REFREESH.REFREESH que dentro dele tem os Call chamando cada consulta no banco que são 5 Módulos igual a estes só muda o SQL
neste caso ele ficaria de um em um minuto buscando no banco de dados alimentando a planilha e atualizando os gráficos ....mais as vezes fica sem atualizar tenho de para a marcro e dar play novamente ...e fico sem saber onde ou pq parou .....coloquei a planilhando rodando em um notebook conectado em um wifi pode ser se tiver problema no wifi ou na conexão com o banco ai para a macro? ??
nestes meus códigos pode ser melhorado alguma coisa??
agradeço qualquer ajuda...
Sub PRIMEIROPARCIAL()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer
Dim F As String
Dim tns As String
Dim login As String
Dim Senha As String
Dim X As String
Dim RCANOT As String
Lin = 28
Do While Not IsEmpty(Worksheets("DADOS").Range("K" & Lin))
X = X & Worksheets("DADOS").Range("K" & Lin).Value & ", "
Lin = Lin + 1
Loop
RCANOT = Left(X, (Len(X) - 2))
tns = Worksheets("DADOS").Range("C26").Value
login = Worksheets("DADOS").Range("C27").Value
Senha = Worksheets("DADOS").Range("C28").Value
F = Worksheets("METADIA").Range("F19").Value
Set cn = New ADODB.Connection
cn.CursorLocation = adUseClient
cn.Open "Driver={Microsoft ODBC for Oracle};" & "CONNECTSTRING=" & tns & ";uid=" & login & ";pwd=" & Senha & ";"
datai = "'" & Worksheets("METADIA").Range("B19").Value & "'"
dataf = "'" & Worksheets("METADIA").Range("C19").Value & "'"
HI = Worksheets("DADOS").Range("B22").Value
hini = "'" & Format(HI, "hh:mm") & "'"
hf = Worksheets("DADOS").Range("D22").Value
hfin = "'" & Format(hf, "hh:mm") & "'"
Set rs = New ADODB.Recordset
Worksheets("DADOS").Range("A4:D18").ClearContents
sql = "SELECT PCPEDC.CODUSUR, PCUSUARI.NOME, COUNT(PCPEDC.NUMPED) QTPEDIDO, SUM(NVL(PCPEDC.VLATEND, 0)) AS VLATEND FROM PCPEDC, PCUSUARI WHERE PCPEDC.CODUSUR = PCUSUARI.CODUSUR AND PCPEDC.CONDVENDA IN (1, 7) AND PCPEDC.DTCANCEL IS NULL AND PCPEDC.DATA >= TO_DATE(" & datai & ",'DD/MM/YYYY') AND PCPEDC.DATA <= TO_DATE(" & dataf & ",'DD/MM/YYYY')" & _
"AND TO_CHAR(TO_DATE(PCPEDC.HORA||':'||PCPEDC.MINUTO, 'HH24:MI'), 'HH24:MI') >=" & hini & "AND TO_CHAR(TO_DATE(PCPEDC.HORA||':'||PCPEDC.MINUTO, 'HH24:MI'), 'HH24:MI') <=" & hfin & "AND PCPEDC.CODFILIAL IN ('1','2') AND PCPEDC.CODUSUR NOT IN (" & RCANOT & ")" & _
"GROUP BY PCPEDC.CODUSUR, PCUSUARI.NOME ORDER BY VLATEND DESC"
rs.Open sql, cn
i = 3
If Not rs.EOF Then
Do While Not rs.EOF
Worksheets("DADOS").Range("A" & i + 1).Value = rs(0)
Worksheets("DADOS").Range("B" & i + 1).Value = rs(1)
Worksheets("DADOS").Range("C" & i + 1).Value = rs(2)
Worksheets("DADOS").Range("D" & i + 1).Value = rs(3)
rs.MoveNext
i = i + 1
Loop
End If
cn.Close
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Postado : 15/07/2016 10:48 am