Notifications
Clear all

Loop revesando Sheets

14 Posts
4 Usuários
0 Reactions
1,782 Visualizações
(@userplan)
Posts: 7
Active Member
Topic starter
 

Bom dia, poderiam me ajudar a realizar um loop em uma macro, preciso que ela fique em loop infinito.

Esse é meu código:

Public Sub Muda_Planilha()
Call Application.OnTime(Now + TimeValue("00:00:15"), "Muda_1")
Call Application.OnTime(Now + TimeValue("00:00:30"), "Muda_2")
Call Application.OnTime(Now + TimeValue("00:00:45"), "Muda_3")
Call Application.OnTime(Now + TimeValue("00:01:00"), "Muda_4")
Call Application.OnTime(Now + TimeValue("00:01:15"), "Muda_5")
Call Application.OnTime(Now + TimeValue("00:01:30"), "Muda_6")
Call Application.OnTime(Now + TimeValue("00:01:45"), "Muda_7")
End Sub

Sub Muda_1()
Sheets("Meta Fat").Select
End Sub
Sub Muda_2()
Sheets("Meta Pecas").Select
End Sub
Sub Muda_3()
Sheets("Meta Unit").Select
End Sub
Sub Muda_4()
Sheets("Fat Anual").Select
End Sub
Sub Muda_5()
Sheets("Pecas Anual").Select
End Sub
Sub Muda_6()
Sheets("Unit Anual").Select
End Sub
Sub Muda_7()
Sheets("Cliente Anual").Select
End Sub

Sub VoltarParaInicio()
    ThisWorkbook.Worksheets("Meta Fat").Select
End Sub
 
Postado : 17/10/2017 4:34 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia UserPlan,

Eu utilizaria de uma outra forma, mas o loop infinito como pediu, pode fazer assim:

Public Sub Muda_Planilha()
Dim i   As Byte

    Do
        i = i + 1
        Call Application.OnTime(Now + TimeValue("00:00:15"), "Muda_" & i)
        If i Mod 7 = 0 Then i = 0
    Loop
    
End Sub

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 17/10/2017 7:19 am
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

UserPlan,

Bom dia!

Seu tópico foi movido para o local adequado VBA & Macros pois o local onde você postou é reservado somente para a apresentação de novos integrantes do fórum.

Solicitamos também, por gentileza, quando postar códigos VBA aqui no fórum, utilizar a TAG CODE existente no começo da caixa de mensagens.

Como você é novato aqui no fórum, para melhor aproveitamento do mesmo e manutenção do fórum de forma organizada, pedimos ler atentamente as mensagens abaixo:
viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 17/10/2017 8:41 am
(@userplan)
Posts: 7
Active Member
Topic starter
 

Bernardo

Bom dia, no caso onde eu colocaria esse código, no módulo ou na pasta de trabalho? Desculpe a pergunta, mas sou novo no excel.....

 
Postado : 17/10/2017 8:57 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Cara, eu colocaria em um módulo.

Ela ficaria no lugar desse código:

Public Sub Muda_Planilha()
Call Application.OnTime(Now + TimeValue("00:00:15"), "Muda_1")
Call Application.OnTime(Now + TimeValue("00:00:30"), "Muda_2")
Call Application.OnTime(Now + TimeValue("00:00:45"), "Muda_3")
Call Application.OnTime(Now + TimeValue("00:01:00"), "Muda_4")
Call Application.OnTime(Now + TimeValue("00:01:15"), "Muda_5")
Call Application.OnTime(Now + TimeValue("00:01:30"), "Muda_6")
Call Application.OnTime(Now + TimeValue("00:01:45"), "Muda_7")
End Sub

Ele evita a repetição colocando em loop.

O código completo colocaria em um módulo assim:

Public Sub Muda_Planilha()
Dim i   As Byte

    Do
        i = i + 1
        Call Application.OnTime(Now + TimeValue("00:00:15"), "Muda_" & i)
        If i Mod 7 = 0 Then i = 0
    Loop
   
End Sub

Sub Muda_1()
Sheets("Meta Fat").Select
End Sub
Sub Muda_2()
Sheets("Meta Pecas").Select
End Sub
Sub Muda_3()
Sheets("Meta Unit").Select
End Sub
Sub Muda_4()
Sheets("Fat Anual").Select
End Sub
Sub Muda_5()
Sheets("Pecas Anual").Select
End Sub
Sub Muda_6()
Sheets("Unit Anual").Select
End Sub
Sub Muda_7()
Sheets("Cliente Anual").Select
End Sub

Sub VoltarParaInicio()
    ThisWorkbook.Worksheets("Meta Fat").Select
End Sub

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 17/10/2017 10:34 am
(@userplan)
Posts: 7
Active Member
Topic starter
 

Boa tarde Bernardo,

Então fiz esse procedimento, porem, a planilha trava e não sai da primeira aba, no caso eu preciso que ela rode as abas sem parar, começando da 1ª até a 7ª com temporizador igual deixei na fórmula, pois cada aba dessa tem um gráfico que fica atualizando o tempo tempo, por isso a necessidade de quando chegar na aba 7 ela retornar para aba 1 constantemente.

 
Postado : 17/10/2017 10:55 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde UserPlan,

Não havia realizado testes. De fato a planilha trava, pois ela executa o loop de uma vez.

Bom, fiz umas modificações e inseri comentários.
Basta executar a OnLoop para começar e a OffLoop para parar o loop.

'Obriga a declaração de variáveis
Option Explicit
'Variável global indicando que o loop está habilitado
Dim runLoop As Boolean

Public Sub onLoop() 'Essa macro inicia o loop
    'Habilita a variável global para começar o loop
    runLoop = True
    
    'Agenda a execução da macro para a troca das Sheets
    Call Application.OnTime(Now + TimeValue("00:00:05"), "Muda_Planilha")
End Sub

Public Sub OffLoop() 'Essa macro finaliza o loop
    'Habilita a variável global para começar o loop
    runLoop = False
    
    'Seleciona a Sheet Meta Fat
    ThisWorkbook.Worksheets("Meta Fat").Select
End Sub

Sub VoltarParaInicio() 'Permaneci com essa macro
    'Seleciona a Sheet Meta Fat
    ThisWorkbook.Worksheets("Meta Fat").Select
End Sub

Public Sub Muda_Planilha() 'Essa macro faz o reconhecimento das Sheets e altera para a seguinte
'Declaração de variáveis
Dim ws()    As Variant
    
    'Um array com o nome das planilhas a iniciar o loop em ordem
    ws = Array("Meta Fat", "Meta Pecas", "Meta Unit", "Fat Anual", "Pecas Anual", "Unit Anual", "Cliente Anual")
    
    'Seleciona a próxima planilha identificando a planilha atual
    ThisWorkbook.Worksheets(ws(IndiceSheet(ThisWorkbook.ActiveSheet.Name, ws))).Select
    'Verifica a variável global está habilitada, caso esteja, chama o agendamento da macro para trocar as Sheets
    If runLoop = True Then Call onLoop
   
End Sub

Public Function IndiceSheet(ByVal wsName As String, ByVal ws As Variant) As Byte 'Essa macro retorna o índice da próxima Sheet
'Verificação de erro e desvia para o final do código
On Error GoTo Primeiro
    
    'Procura a posição em que a planilha ativa está em relação as planilhas indicadas no array
    IndiceSheet = Application.Match(ThisWorkbook.ActiveSheet.Name, ws, 0)
    
    'Verifica se chegou na última planilha
    If IndiceSheet = UBound(ws) + 1 Then IndiceSheet = 0
    
    'Finaliza a função
    Exit Function
'Rótulo indicado no caso de erro
Primeiro:
    'Indica para a primeira Sheet
    IndiceSheet = 0
End Function

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 17/10/2017 12:50 pm
(@userplan)
Posts: 7
Active Member
Topic starter
 

Bernardo

Boa tarde, por favor poderia ver na própria planilha em anexo se funciona? aqui para mim apresentou erro em algumas linhas.

 
Postado : 17/10/2017 1:15 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde UserPlan,

Os erros que estão ocorrendo são do código antigo.
Os nomes ficam repetidos e ele dá erro.
Remove todo o código antigo e executa apenas o novo.

Outra coisa, os nomes das Sheets podem ser minúscula, no código coloquei para converter para maiúscula.
Alterei a relação dos nomes para maiúsculas, e outra coisa, a última Sheet está no plural. Estava dando erro também.

Tenta esse novo código:

'Obriga a declaração de variáveis
Option Explicit
'Variável global indicando que o loop está habilitado
Dim runLoop As Boolean

Public Sub onLoop() 'Essa macro inicia o loop
    'Habilita a variável global para começar o loop
    runLoop = True
   
    'Agenda a execução da macro para a troca das Sheets
    Call Application.OnTime(Now + TimeValue("00:00:05"), "Muda_Planilha")
End Sub

Public Sub OffLoop() 'Essa macro finaliza o loop
    'Habilita a variável global para começar o loop
    runLoop = False
   
    'Seleciona a Sheet Meta Fat
    DoEvents: ThisWorkbook.Sheets("Meta Fat").Select
End Sub

Sub VoltarParaInicio() 'Permaneci com essa macro
    'Seleciona a Sheet Meta Fat
    ThisWorkbook.Worksheets("Meta Fat").Select
End Sub

Public Sub Muda_Planilha() 'Essa macro faz o reconhecimento das Sheets e altera para a seguinte
'Declaração de variáveis
Dim ws()    As Variant
   
     'Verifica a variável global está habilitada, caso não esteja, finaliza o código
     If runLoop = False Then Exit Sub
   
    'Um array com o nome das planilhas a iniciar o loop em ordem
    ws = Array("META FAT", "META PECAS", "META UNIT", "FAT ANUAL", "PECAS ANUAL", "UNIT ANUAL", "CLIENTES ANUAL")
   
    'Seleciona a próxima planilha identificando a planilha atual
    ThisWorkbook.Sheets(ws(IndiceSheet(UCase(ThisWorkbook.ActiveSheet.Name), ws))).Activate
    
    'Chama o agendamento da macro para trocar as Sheets
    Call onLoop
   
End Sub

Public Function IndiceSheet(ByVal wsName As String, ByVal ws As Variant) As Byte 'Essa macro retorna o índice da próxima Sheet
'Verificação de erro e desvia para o final do código
On Error GoTo Primeiro
   
    'Procura a posição em que a planilha ativa está em relação as planilhas indicadas no array
    IndiceSheet = Application.Match(wsName, ws, 0)
   
    'Verifica se chegou na última planilha
    If IndiceSheet = UBound(ws) + 1 Then IndiceSheet = 0
   
    'Finaliza a função
    Exit Function
'Rótulo indicado no caso de erro
Primeiro:
    'Indica para a primeira Sheet
    IndiceSheet = 0
End Function

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 17/10/2017 1:41 pm
(@userplan)
Posts: 7
Active Member
Topic starter
 

Bernardo

Obrigado amigo, agora funcionou 100%

 
Postado : 17/10/2017 1:47 pm
xlarruda
(@xlarruda)
Posts: 732
Honorable Member
 

Já tinha feito isso uma vez . Se quiser tentar a minha...

___________________________________________________________________________________________
Se a resposta atendeu sua dúvida, por favor, clique no Gostei e marque o Tópico como [Resolvido].

Att.

André Arruda

 
Postado : 17/10/2017 2:29 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia xlarruda,

Funciona perfeitamente,
Mas existe algumas necessidades que seu código não atende.

Ela alterna entre todas as Sheets, sem escolha de determinadas planilhas.

Se tiver uma Sheet oculta, não vai exibir, entretanto, isso não vai resolver a questão, visto que a anterior a essa oculta vai considerar como se estivesse mudado para ela mas não vai exibi-la, fazendo com que a anterior demore o dobro do tempo.

A ordem de exibição será a ordem das Sheets, sem a opção de que altere a ordem de exibição indiferente da posição das planilhas.

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 18/10/2017 6:41 am
xlarruda
(@xlarruda)
Posts: 732
Honorable Member
 

Entendo. Na verdade , analisando bem, minha necessidade era bem mais simples mesmo.
Obrigado pela explicação!

Abrç!

___________________________________________________________________________________________
Se a resposta atendeu sua dúvida, por favor, clique no Gostei e marque o Tópico como [Resolvido].

Att.

André Arruda

 
Postado : 18/10/2017 6:47 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

O princípio e o funcionamento é o mesmo, a que eu fiz só foi mais chatinha por causa dessas necessidades mesmo.

Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 18/10/2017 6:54 am