Notifications
Clear all

Planilha Ficar rodando Macro Automaticamente

6 Posts
2 Usuários
0 Reactions
943 Visualizações
(@tairone)
Posts: 0
New Member
Topic starter
 

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
(@mprudencio)
Posts: 0
New Member
 

Sim se vc tiver problemas de conexão ou no banco de dados seu codigo para de funcionar....

Uma pergunta é realmente necessario atualizar a cada minuto....

Seu banco de dados sofre tantas alterações que isso seja realmente necessario?

Seu codigo é executado em qto tempo?

 
Postado : 15/07/2016 4:49 pm
(@tairone)
Posts: 0
New Member
Topic starter
 

Sim preciso que atualize a cada minuto pois as informações são exibidas são gráficos de percentual de vendas do vendedores....neste caso a cada minuto ele atualiza ...mais posso colocar a cada 2 minutos não teria influencia isso acredito se for 2 ou 1 minutos ...

 
Postado : 16/07/2016 10:53 am
(@mprudencio)
Posts: 0
New Member
 

Nao sei qual o seu volume de vendas e nao sei qto tempo o codigo demora pra processar completo.

Minha sugestão seria executar o codigo atraves de 1 botao e vc atualiza sempre que julgar necessario, acredito ter menos problemas...

Experimente e veja se tera problemas.

 
Postado : 16/07/2016 4:29 pm
(@tairone)
Posts: 0
New Member
Topic starter
 

o problema e que quero colocar uma tela com um gráfico atualizado com os dados ...sendo assim ela teria de atualizar sozinha!!

 
Postado : 18/07/2016 7:49 am
(@mprudencio)
Posts: 0
New Member
 

Ja tentou usar o tratamento de erros em caso de perca de conexao da rede, ....

Coloque no inicio do codigo apos apllication....

On Error Resume Next

Isso vai forçar a execução do codigo e pode ser que funcione.

 
Postado : 18/07/2016 5:30 pm