leandromgp

Bom dia, Pessoal

 

@Basole, estou utilizando a sua sub do seu exemplo (muito obrigado ajudou bastante),  com algumas alterações para melhor me atender e estou tendo um problema na Private Sub SecondStep().

Ela esta pulando a linha SendKeys ("^v"), chega a selecionar a célula A8 e não copia. Eu olhei na área de transferência e existe dado copiado e ele segue os comando normalmente ativando o numlock e etc.

 

Segue a Private sub:

 

Private Sub SecondStep()
SendKeys ("%fx")
Myself = "Microsoft Excel - " & ActiveWindow.Caption
ThisWorkbook.Activate
Sheets("MODELO").Select
Sheets("MODELO").Copy After:=Sheets(1)
Range("A8").Activate
SendKeys ("^v")
SendKeys "{NUMLOCK}"

Application.OnTime Now + TimeValue("00:00:10"), "thirdStep"

End Sub

Boa Tarde Pessoal,

 

Tenho uma Macro que executa um loop ate determinada condição e gostaria de chamar um modulo inteiro nessa macro.

 

Existe algum comando que posso fazer isso?

 

 

A instrução 1 (Módulo 2) esta funcionando perfeitamente, preciso colocar ela na instrução 1.

 

Desde já agradeço...

 

segue das instruções:

 

Instrução 1:

 

 

<Sub repeticao()

Dim AdobeFile As String

Sheets("ENTRADA").Select

linha = 5

Do Until Cells(linha, = ""

    If Cells(linha, <> "" Then
            Cells(linha, 8).Select
            Call Módulo2
    End If
    
    linha = linha + 1
    
Loop

End Sub>

 

Instrução 2

 

<Sub StartAdobe()
Dim AdobeApp As String
Dim AdobeFile As String
Dim value As String
Dim valor As String
Dim StartAdobe

AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"

AdobeFile = ActiveCell

StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)
 
Application.OnTime Now + TimeValue("00:00:05"), "FirstStep"

End Sub
Private Sub FirstStep()
SendKeys ("^a")
SendKeys ("^c")

Application.OnTime Now + TimeValue("00:00:10"), "SecondStep"
 
End Sub
 
Private Sub SecondStep()
SendKeys ("%fx")
AppActivate "Excel"
ThisWorkbook.Activate
Sheets("MODELO").Select
Sheets("MODELO").Copy After:=Sheets(1)
Range("A1").Activate
SendKeys ("^v")
ActiveCellSendKeys "{NUMLOCK}"

Application.OnTime Now + TimeValue("00:00:05"), "thirdStep"

End Sub

Private Sub thirdStep()

Sheets("MODELO (2)").Select
    Set Rng = Range("A1")
    
    valor = "Data pregão"
          
    Do While Rng.value <> ""
        Rng.Select
        
        If Rng.value = valor Then
            Rng.Offset(1, 1).Select
            ActiveCell.FormulaR1C1 = _
            "=YEAR(RC[-1])&TEXT(MONTH(RC[-1]),""00"")&TEXT(DAY(RC[-1]),""00"")"
            Sheets("MODELO (2)").Select
            Sheets("MODELO (2)").Name = Rng.Offset(1, 1).value
            Range("A1").Select
            Columns("A:A").EntireColumn.AutoFit
            Columns("B:B").EntireColumn.Delete
            Exit Sub
            
        End If
        
        Set Rng = Rng.Offset(1, 0)
        
    Loop
   
End Sub>

 

esse  é o numero "8", não sei porque apareceu isso...

@Basole , Boa tarde prezado Basole,

 

Eu criei um novo tópico com essa dúvida, se puder acessar lá e esclarecer essa dúvida agradeço demais...

 

Boa Noite, 

 

Parabéns pela solução, me ajudou bastante !!!

 

Gostaria de saber como faço para colocar uma caixa de endereço para selecionar um arquivo especifico?