Como generar archivos txt (ARCHIVO 1).
Para seguir con la generación de los archivos txt, una vez que traspasados los datos a la hoja “Archivo” se debe generar el archivo para banco para la sociedad 100.
El formato del archivo es “Texto, (delimitado por tabulaciones)”
Se adjunta formato archivo 100 con el formato a utilizar. También se especifica si debemos rellenar con blancos o ceros hasta completar los caracteres solicitados en formato de archivo.
Hay que tener en cuenta que cuando el código banco en la soc 100 sea 510, debe agregarse 0510 al número de cuenta.
Cuenta: 11100000921132
Cuenta en archivo : 051011100000921132
En Archivo Banco, hoja “Variables”, se indica el nombre del archivo que debiera llevar la sociedad 100 una vez generado. Esto con la finalidad que sea dinámica la asignación del nombre del archivo.
El nombre que debiera llevar el archivo es celda j2 + mes y año de generación (Ej: AA201604.txt) y la carpeta en que deberá quedar la información (en este caso celda m2).
1 respuesta
H o l a:
Te anexo las macros
Sub Generar()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("BASE")
Set h2 = Sheets("ARCHIVO")
Set h3 = Sheets("VARIABLES")
Set h4 = Sheets("SALIDA")
h2.UsedRange.Offset(1, 0).Clear
j = 2
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "A") <> "" And IsNumeric(h1.Cells(i, "A")) Then
h1.Rows(i).Copy h2.Rows(j)
Set b = h3.Columns("A").Find(h1.Cells(i, "B"), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(j, "E") = h3.Cells(b.Row, "C")
h2.Cells(j, "F") = h3.Cells(b.Row, "D")
h2.Cells(j, "G") = h3.Cells(b.Row, "E")
End If
j = j + 1
End If
Next
Call Salida1(h2, h3, h4)
MsgBox "Fin"
End Sub
'
Sub Salida1(h2, h3, h4)
'Por.Dante Amor
h4.Cells.Clear
j = 1
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
If h2.Cells(i, "A") = 100 Then
h4.Cells(j, "A") = Format(h2.Cells(i, "B"), "'000000000") 'ID
'h4.Cells(j, "B") = String(15, " ") 'espacios
h4.Cells(j, "C") = h2.Cells(i, "C") 'nombre
h4.Cells(j, "D") = 1 'indicativo
h4.Cells(j, "E") = Format(h2.Cells(i, "E"), "'000") 'banco
If h2.Cells(i, "E") = 510 Then ag = "'0510" Else ag = "'" 'agregar a no. cuenta
h4.Cells(j, "F") = ag & h2.Cells(i, "G") 'no. cuenta
h4.Cells(j, "G") = h2.Cells(i, "F") 'tipo cuenta
h4.Cells(j, "H") = Format(h2.Cells(i, "D"), "'000000000") 'importe
j = j + 1
End If
Next
cols = Array("", "9", "15", "45", "1", "3", "20", "1", "9")
For i = 1 To UBound(cols)
h4.Columns(i).ColumnWidth = cols(i)
Next
ruta = ThisWorkbook.Path & "\"
h4.Copy
Set b = h3.Columns("H").Find(100, lookat:=xlWhole)
If Not b Is Nothing Then
arch = h3.Cells(b.Row, "J")
Else
arch = ""
End If
arch = arch & Format(Date, "yyyymm")
ActiveWorkbook.SaveAs Filename:=ruta & arch, FileFormat:=xlTextPrinter, CreateBackup:=False
ActiveWorkbook.Close
End Sub' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
Estimado
Me genera un archivo con formato correcto en cuanto a contenido.
Pero el archivo lo genera con extensión RPN, podría generarse con extensión txt?
Te anexo la macro actualizada
Sub Generar()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("BASE")
Set h2 = Sheets("ARCHIVO")
Set h3 = Sheets("VARIABLES")
Set h4 = Sheets("SALIDA")
h2.UsedRange.Offset(1, 0).Clear
j = 2
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "A") <> "" And IsNumeric(h1.Cells(i, "A")) Then
h1.Rows(i).Copy h2.Rows(j)
Set b = h3.Columns("A").Find(h1.Cells(i, "B"), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(j, "E") = h3.Cells(b.Row, "C")
h2.Cells(j, "F") = h3.Cells(b.Row, "D")
h2.Cells(j, "G") = h3.Cells(b.Row, "E")
End If
j = j + 1
End If
Next
Call Salida1(h2, h3, h4)
MsgBox "Fin"
End Sub
'
Sub Salida1(h2, h3, h4)
'Por.Dante Amor
h4.Cells.Clear
j = 1
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
If h2.Cells(i, "A") = 100 Then
h4.Cells(j, "A") = Format(h2.Cells(i, "B"), "'000000000") 'ID
'h4.Cells(j, "B") = String(15, " ") 'espacios
h4.Cells(j, "C") = h2.Cells(i, "C") 'nombre
h4.Cells(j, "D") = 1 'indicativo
h4.Cells(j, "E") = Format(h2.Cells(i, "E"), "'000") 'banco
If h2.Cells(i, "E") = 510 Then ag = "'0510" Else ag = "'" 'agregar a no. cuenta
h4.Cells(j, "F") = ag & h2.Cells(i, "G") 'no. cuenta
h4.Cells(j, "G") = h2.Cells(i, "F") 'tipo cuenta
h4.Cells(j, "H") = Format(h2.Cells(i, "D"), "'000000000") 'importe
j = j + 1
End If
Next
cols = Array("", "9", "15", "45", "1", "3", "20", "1", "9")
For i = 1 To UBound(cols)
h4.Columns(i).ColumnWidth = cols(i)
Next
ruta = ThisWorkbook.Path & "\"
h4.Copy
Set b = h3.Columns("H").Find(100, lookat:=xlWhole)
If Not b Is Nothing Then
arch = h3.Cells(b.Row, "J")
Else
arch = "sin nombre"
End If
arch = arch & " " & Format(Date, "yyyymm") & ".txt"
ActiveWorkbook.SaveAs Filename:=ruta & arch, FileFormat:=xlTextPrinter, CreateBackup:=False
ActiveWorkbook.Close
End Sub' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
