Este fórum está sendo desativado

[Pegorini]

Olá Senhores.

Encontrei no fórum uma excelente macro desenvolvida pelo Laender para importar arquivo txt no leiaute do sped fiscal.

Contudo tenho uma necessidade específica que a macro não me atende.
A minha necessidade é de que a macro importe cada registro em uma planilha específica. Para facilitar o nome da planilha poderá ter o mesmo do registro. por exemplo, registro 0150 será importado na planilha com nome "0150", assim os dados deste registro devem estar na planilha "0150".

Anexo apresento a planilha do Laender "SPED", a minha "IMPORTAR SPED" e um arquivo modelo txt do sped.

Importante esclarecer que os registros são as primeiras colunas de delimitadores do arquivo e a informação a ser importada está na linha dele.


E por fim , se possível, que as informações sejam importadas a partir da linha 02.

Muito obrigado.

[Jimmy]

Olá,

A macro abaixo lê o arquivo TXT e joga nas planilhas cujo nome é definido pelo primeiro campo do registro. Se a planilha não existe (ainda não foi lido nenhum registro com esse nome) ela cria. Se já existir, ela acrescenta aos dados já existentes nessa planilha.

Antes de iniciar a leitura, todas as planilhas que por ventura tenham sobrado de execuções anteriores são apagadas. Para saber quais as planilhas apagar, defini que as planilhas com os dados lidos tem o nome iniciado por ponto “.” (ex. “.0150”). Assim, antes de iniciar a leitura do aquivo, todas as planilhas que iniciem por ponto, serão apagadas. Esse caracter pode ser alterar, atribuindo-se um outro (deve ser válido para nome de planilha) na variável Char.

O que falta agora é juntar com a planilha do Lander para aproveitar o formulário, etc. Se tiver dificuldade nisso, avise.

Jimmy San Juan

Código: Selecionar todos

Sub AbreArqTxt()
    Pasta = "C:\"
    Arqui = "SPED.txt"
    Char = "."
    
    Aux1 = Application.DisplayAlerts: Application.DisplayAlerts = False
    For Each Plani In ThisWorkbook.Sheets
        If Left(Plani.Name, 1) = Char Then Plani.Delete
    Next
    Application.DisplayAlerts = Aux1
    
    Open Pasta & Arqui For Input As #1
    
    Do While Not EOF(1)
        Line Input #1, Linha
        If Linha <> "" Then
            Inicio = InStr(2, Linha, "|")
            Plani = Mid(Linha, 2, Inicio - 2)
            Linha = Mid(Linha, Inicio + 1, Len(Linha) - 7)
            Campos = Split(Linha, "|")
            On Error Resume Next
            Sheets(Char & Plani).Select
            Erro = Err
            On Error GoTo 0
            If Erro <> 0 Then
                Sheets.Add After:=ActiveSheet
                ActiveSheet.Name = Char & Plani
                Sheets(Char & Plani).Move After:=Sheets(Sheets.Count)
            End If
            Lin = Range("A" & Rows.Count).End(xlUp).Row + 1
            Range(Cells(Lin, "A"), Cells(Lin, UBound(Campos) + 1)).Select
            Selection.Value = Campos
            Cells(1, 1).Select
        End If
    Loop
    Close

End Sub

[Pegorini]

Olá Jimmi.

Farei os testes, mas antecipadamente agradeço sua atenção e disponibilidade em me ajudar.

Muito Grato mesmo.

[Pegorini]

Olá Jimmy

Ficou perfeito. Estou muito contente, pois e ajudará muito.

Tentei adaptar o excelente formulário do Laender, a sua macro, mas não consegui. É possível você mais uma vez me ajudar ?

[Jimmy]

Pegorini,

Tem muita coisa na planilha do Lander que não sei se você precisa. Pra pedir o caminho de um arquivo não precisa necessariamente de um formulário. Dá pra fazer a macro abrir uma janela de seleção de arquivos e só. Então, teria que entender o código dele e entender porque é que ele fez dessa forma.

Acho que o caminho mais fácil é partir da sua necessidade, e ver o que falta na macro que te mandei. É só encolher o arquivo TXT? Se for só isso, nem precisamos olhar o que ele fez.

Me diga o que está faltando e acertamos.

Jimmy San Juan

[Pegorini]

Oi Jimmy.

Obrigado pelo retorno.

Exatamente isso. O que me interessa, de fato, é abrir uma janela para escolher o arquivo. Não necessariamente o formulário do Laender.

[Jimmy]

Bom dia!

Veja se o código abaixo está da forma que precisa:

Código: Selecionar todos

Sub AbreArqTxt()

   'Pede o nome do arquivo
    Sped = Application.GetOpenFilename( _
            Title:="Selecione um arquivo de texto SPED para importar", _
            FileFilter:="Arquivo SPED (*.txt),*.txt", _
            MultiSelect:=False)
    Pasta = Mid(Sped, 1, InStrRev(Sped, "\"))
    Arqui = Mid(Sped, InStrRev(Sped, "\") + 1)
    Char = "."
    
   'Apaga planilhas anteriores
    Aux1 = Application.DisplayAlerts: Application.DisplayAlerts = False
    For Each Plani In ThisWorkbook.Sheets
        If Left(Plani.Name, 1) = Char Then Plani.Delete
    Next
    Application.DisplayAlerts = Aux1
    Set Aqui = ActiveSheet
    
   'Lê linha a linha do arquivo
    Open Pasta & Arqui For Input As #1
    Do While Not EOF(1)
        Line Input #1, Linha
        If Linha <> "" Then
           'Separa o primeiro registro dos demais
            Inicio = InStr(2, Linha, "|")
            Plani = Mid(Linha, 2, Inicio - 2)
            Linha = Mid(Linha, Inicio + 1, Len(Linha) - 7)
            Campos = Split(Linha, "|")
            
           'Seleciona planilha correta, e se não existe, cria
            On Error Resume Next
            Sheets(Char & Plani).Select
            Erro = Err
            On Error GoTo 0
            If Erro <> 0 Then
                Sheets.Add After:=ActiveSheet
                ActiveSheet.Name = Char & Plani
                Sheets(Char & Plani).Move After:=Sheets(Sheets.Count)
            End If
            
           'Copia os registros lidos do TXT para a primeira linha livre da planilha
            Lin = Range("A" & Rows.Count).End(xlUp).Row + 1
            Range(Cells(Lin, "A"), Cells(Lin, UBound(Campos) + 1)).Value = Campos
        End If
    Loop
    Close
    Aqui.Select
End Sub

Jimmy San Juan

[Pegorini]

Oi Jimmy.

Funcionou perfeitamente.

Muito obrigado pela ajuda.