CONDIÇÃO DE PARADA NÃO RESPEITADA

[Luciano Bonavides de Oliveira]

   Bom dia a todos. Tenho a seguinte situação, relativamente simples, mas que está me intrigando:

 

Private Sub cmdMascara_Click()
    Dim ultlinha As Long
    Dim i As Long
    
    ultlinha = Worksheets("AUDIENCIAS").Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
    i = 2
    While True
        Range("A" & i).Select
        SendKeys "{F2}", True
        SendKeys "{ENTER}", True
        i = i + 1
        If i >= ultlinha Then
            Exit Sub
        End If
    Wend
End Sub

 

   Tentei de diversas formas. Esta foi a tentativa mais recente. O que está ocorrendo é que a condição de parada não está sendo respeitada: o envio de teclas está ocorrendo indefinidamente. Tentei inicialmente com for, depois com while de duas formas e por último, a forma mostrada acima. Alguém tem idéia do está ocorrendo? Agradeço antecipadamente.

[Luciano Bonavides de Oliveira]

   Após acrescentar um trecho para o código pausar por um tempo, a cada iteração, está saindo do laço, mas o comportamento ainda é muito estranho: ele retorna ao depurador numa janela que mostra as classes dos objetos e fica piscando, como se as teclas ainda estivem sendo enviadas. Segue novo código:

 

Private Sub cmdMascara_Click()
    Dim ultlinha As Long
    Dim i As Long
    
    ultlinha = Worksheets("AUDIENCIAS").Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
    i = 2
    While True
        Range("A" & i).Select
        SendKeys "{F2}", True
        SendKeys "{ENTER}", True
        H = Hour(Now())
        M = Minute(Now())
        S = Second(Now()) + 0.5
        espera = TimeSerial(H, M, S)
        Application.Wait espera
        i = i + 1
        If i >= ultlinha Then
            Exit Sub
        End If
    Wend
End Sub

[Alyson Ronnan Martins]

Conseguiu a solução?

 

[Luciano Bonavides de Oliveira]

   Boa noite Alyson. Utilizando sendkeys, não consegui. Mudei totalmente minha estratégia para resolver meu problema.

[Alyson Ronnan Martins]

Dim continueWriting As Boolean

Sub StartWriting()
    continueWriting = True
    WriteText
End Sub

Sub StopWriting()
    continueWriting = False
End Sub

Sub WriteText()
    Dim rng As Range
    Set rng = Range("A1")
    
    While continueWriting
        If Application.SendKeys("{F2}") Then
            Exit Sub
        Else
            rng.Value = "A"
            Set rng = rng.Offset(1, 0)
        End If
    Wend
End Sub

[Luciano Bonavides de Oliveira]

   Show de bola Alyson. Testarei aqui e respondo em outro momento. Já resolvi de outra forma, mas será útil em outros projetos.

[Alyson Ronnan Martins]

Uma correção para o código:

Public StatusContinueWrite As Boolean
Public CurrentLine As Long

Public Sub main()
StatusContinueWrite = True: CurrentLine = 1
update
End Sub

Private Sub update()
If StatusContinueWrite Then
    WriteOnLines
    Application.OnTime Now + TimeValue("00:00:01"), "update"
Else
    MsgBox "Terminou"
End If
End Sub

Private Sub WriteOnLines()
Range("A" & CurrentLine).Value = "A": CurrentLine = CurrentLine + 1
End Sub

Agora um exemplo de como está o código:

Arquivo exemplo no google drive: https://drive.google.com/file/d/1XGf5VDCiWvzI9lyLk__PeshyVibj52HF/view?usp=sharing

Verifica esse último código.