none
Erro de execucao 9 - Subscrito fora do intervalo RRS feed

  • Pergunta

  • Criei uma macro numa planilha consolidadora de dados de várias regiões de minha empresa chamadas DRs. A macro abrir as respectivas planilhas, copiar blocos localizados em abas específicas e, ao finalizar, inclui o trecho a seguir que ativa cada uma das planilhas abertas e as fecha sem salvar. Ao executar o VBA executa a primeira parte (copiar as tabelas), mas apresenta no final da subrotina a mensagem de "Erro de execução '9' - Subscrito fora do intervalo, parando a depuração no comando "Windows(Arq).Activate". Alguém pode indicar o que está errado?

    Dim Arq As String

    Dim Compl As String  

    Compl = ThisWorkbook.Path
    Arq = Compl + "\" + "DR_"

    DR = Array("03", "04", "05", "06", "08", "10", "12", "14", "16", "18", "20", "22")
    i = 0

    Do While i < 11
       Arq = Arq + CStr(DR(i)) + ".xlsx"

        Windows(Arq).Activate
        Application.DisplayAlerts = False
        ThisWorkbook.Close
        Application.DisplayAlerts = True

        i = i + 1
        Arq = Compl + "\" + "DR_"

    Loop

                    
    quinta-feira, 20 de outubro de 2016 17:18

Todas as Respostas

  • Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum. Uma janela aparecerá onde você deverá colar seu código cru na caixa de texto à esquerda. Então, selecione a opção Vb.Net na caixa de combinação que você verá em cima à esquerda e depois clique no botão Inserir.

    ---

    Seu código está dando erro porque não encontra uma janela com o nome da variável "Arq".

    Sugiro que acrescente a linha Debug.Print Arq antes da linha Windows(Arq).Activate para ver em qual valor dessa variável sua macro está falhando.




    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    quinta-feira, 20 de outubro de 2016 17:30
    Moderador
  • O erro ocorre já na execução do primeiro valor (i = 0) da variável Arq que é 'D:\ArquivosExcel\DR_03.XSLX'. Inicialmente, pensei tratar-se de falha do método Windows(Arq).Activate em reconhecer o valor da variável Arq, dado que o caminho onde estão as planilhas no servidor é muito extenso e com caracteres especiais 'ç' e 'ã'. Aí copiei a pasta para meu micro e continua com o mesmo erro.
    quinta-feira, 20 de outubro de 2016 18:17
  • Há código faltando na sua macro. Por exemplo: onde está o bloco de código que copia o conteúdo de uma planilha a outra? E o trecho que abre a pasta de trabalho?

    Sugiro usar este suplemneto: http://www.rondebruin.nl/win/addins/rdbmerge.htm


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    sexta-feira, 21 de outubro de 2016 00:42
    Moderador
  • Sub Roubo()
    '
    ' Roubo Macro
    '
    On Error GoTo ErrMsg
    
    Dim Arq As String
    Dim i As Integer
    Dim chkErro As Integer
    Dim Compl As String
    
    '============ Copiar conteúdo das palnilhas das DRs
    
    DR = Array("03", "04", "05", "06", "08", "10", "12", "14", "16", "18", "20", "22", "24", "26", "28", "30", "32", "34", "36", "50", "60", "64", "65", "68", "70", "72", "74", "75")
    DRsgl = Array("ACR", "AL", "AP", "AM", "BA", "BSB", "CE", "ES", "GO", "MA", "MG", "MS", "MT", "RO", "PA", "PB", "PE", "PI", "RJ", "RN", "RS", "RR", "SC", "SE", "SPM", "SPI", "TO")
    
    
    Compl = ThisWorkbook.Path
    
    Arq = Compl + "\" + "DR_"
    
    
    i = 0
    chkErro = 0
    
    Do While i < 2
    
    
    Arq = Arq + CStr(DR(i)) + ".xlsx"
    
    '
    If Dir(Arq) = vbNullString Then
        
        chkErro = 1
        GoTo ErrMsg
        
        Else
    
        Workbooks.Open Filename:=Arq
        
      
        On Error GoTo ErrMsg
        Sheets("ROUBO").Select
        
        Range("A3:I3").Select
    
        Range(Selection, Selection.End(xlDown)).Select
    
        Selection.Copy
        Windows("prejuízos_indenizar_ECT.xlsm").Activate
        Sheets("ROUBO").Select
    
        Range("A2:A2").Select
        Selection.End(xlDown).Select
        chkErro = 0
    
    End If
            
        If i > 1 Then
        
                      Selection.End(xlDown).Select
        End If
              
             
      
        ActiveCell.Offset(1, 0).Range("A1").Select
        ActiveSheet.Paste
    
    
    
        
    ErrMsg:
    If chkErro = 1 Then
    
        MsgBox ("Arquivo da DR " & CStr(DRsgl(i)) & " não localizado ou Aba Roubo inexistente"), , "Mensagem ausência de dados"
        chkErro = 0
    End If
        Arq = Compl + "\" + "DR_"
    
    i = i + 1
    
    Loop
    
    '========= Fechar todos os arquivos das DRs ===============
    
    Compl = ThisWorkbook.Path
    
    Arq = Compl + "\" + "DR_"
    
    DR = Array("03", "04", "05", "06", "08", "10", "12", "14", "16", "18", "20", "22", "24", "26", "28", "30", "32", "34", "36", "50", "60", "64", "65", "68", "70", "72", "74", "75")
    DRsgl = Array("ACR", "AL", "AP", "AM", "BA", "BSB", "CE", "ES", "GO", "MA", "MG", "MS", "MT", "RO", "PA", "PB", "PE", "PI", "RJ", "RN", "RS", "RR", "SC", "SE", "SPM", "SPI", "TO")
    
    i = 0
    chkErro = 0
    
    Do While i < 3
    
    
    Arq = Arq + CStr(DR(i)) + ".xlsx"
    
    '
    If Dir(Arq) = vbNullString Then
        
        chkErro = 1
        GoTo ErrMsg1
        
        Else
        
        MsgBox ("O nome do último arquivo aberto é " & Arq & " o número de ordem é " & i)
        
        Debug.Print Arq
        Windows(Arq).Activate
        Application.DisplayAlerts = False
        ThisWorkbook.Close
        Application.DisplayAlerts = True
        
    End If
    
    i = i + 1
        Arq = Compl + "\" + "DR_"
        
    ErrMsg1:
        MsgBox ("Arquivo da DR " & CStr(DRsgl(i)) & " não localizado ou Aba Roubo inexistente"), , "Mensagem ausência de dados"
        
    Loop
    
    End Sub

    sexta-feira, 21 de outubro de 2016 17:14
  • Inseri acima todo o código da subrotina. Desculpe não ter feito antes, pois este foi meu primeiro post no Forum.
    sexta-feira, 21 de outubro de 2016 17:16
  • Sugiro experimentar o código do link que te passei.

    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    sexta-feira, 21 de outubro de 2016 17:38
    Moderador