Boa tarde, Colegas.
Trabalho com contabilidade e meu sistema não importa as notas fiscais de serviços da prefeitura de meu município, pois os layouts variam conforme o município, então os desenvolvedores disseram ser inviável fazer a adaptação.
Pois, bem. Estou fazendo uma rotina para importar o XML notas fiscais para o Excel e tratar as informações que eu preciso.
Tenho a worksheet "Importar_XML", que é a planilha com os dados originais, importados diretamente do XML:
Tenho a segunda worksheet "Preparar_Arquivo", que é a planilha onde eu irei escrever alguns dados capturados da planilha "Importar_Arquivo":
O problema que acontece é o seguinte: como podem ver na planilha "Preparar_Arquivo", a rotina está capturando somente o ISS da última nota. Eu preciso que seja capturado o ISS de cada nota e que seja escrito na planilha logo abaixo da respectiva nota. Mas, a captura dos campos do ISS só deve ocorrer se o "IssRetido" da planilha "Importar_XML" for igual a 1.
Segue abaixo como deveria ficar:
Segue abaixo o código:
Sub Prep_Arq()
'Ativa e limpa a planilha Preparar_Arquivo
Worksheets("Preparar_Arquivo").Activate
Range("A2:J99999").ClearContents
'Ativa a planilha Importar_XML
Worksheets("Importar_XML").Activate
'Define a variavel linha = 2. Isso vai fazer com que a pesquisa comece pela segunda linha, uma vez que a primeira e o cabecalho
linha = 2
'Cria um loop enquanto a celula não for vazia
'Alternativa instrucao Do Until IsEmpty(ActiveCell.Offset(0, 0))
Do Until IsEmpty(Cells(linha, 1))
'Copia os dados das celulas indicadas em Cells(linha, coluna) para as variáveis
copia_NF = Cells(linha, 1)
copia_data = Cells(linha, 2)
copia_basecalculo = Cells(linha, 3)
copia_issvalor = Cells(linha, 9)
copia_issret = Cells(linha, 10)
copia_tomador = Cells(linha, 12)
'Posiciona na planilha Preparar_Arquivo
Worksheets("Preparar_Arquivo").Activate
'Escreve na planilha Preparar_Arquivo os dados da nota fiscal
Cells(linha, 1) = copia_data
Cells(linha, 2) = "Vlr ref a prestação de serviço NF " & copia_NF & " " & copia_tomador
Cells(linha, 3) = copia_basecalculo
'Escreve os dados do ISS na próxima linha se a condição for verdadeira
If copia_issret = 1 Then
'Incrementa a variável linha
linha = linha + 1
Cells(linha, 1) = copia_data
Cells(linha, 2) = "Vlr ref a ISS retido NF " & copia_NF
Cells(linha, 3) = copia_issvalor
Else
'Incrementa a variável linha
linha = linha + 1
End If
Worksheets("Importar_XML").Activate
Loop
'Ativa a planilha Preparar_Arquivo na celula A2
Worksheets("Preparar_Arquivo").Activate
Range("A2").Select
End Sub
Postado : 26/10/2015 5:05 pm