Generar .txt con userform en excel
Quisiera generar un codigo para que me genere 2 archivos txt de una misma hoja excel.
1 archivo:
A1:B12
2 archivo
C24:D32
----Los valores que estan en cada celda son numeros, y que la separacion entre columnas seas por un espacio.
H o l a:
Pon la siguiente macro en un módulo; desde tu formulario puedes ejecutarla, solamente pon en un botón de comando el llamado a la macro: GenerarTxt
Sub GenerarTxt()
'Por.Dante Amor
ruta = ThisWorkbook.Path & "\"
rangos = Array("A1:B12", "C24:D32")
For r = LBound(rangos) To UBound(rangos)
FileNum = FreeFile()
Open ruta & "archivo " & r + 1 & ".txt" For Output As #FileNum
Set rango = Range(rangos(r))
numcol = rango.Columns.Count
'
For Each fila In rango.Rows
n = 1
For Each columna In fila.Columns
dato = Format(Cells(fila.Row, columna.Column), "0")
Print #FileNum, dato;
If n < numcol Then Print #FileNum, " ";
n = n + 1
Next
Print #FileNum,
Next
Close #FileNum
Next
'
MsgBox "Archivos txt generados", vbInformation, "GENERAR TXT"
End SubLos nombres de los archivos serán: archivo 1.txt y archivo 2.txt
muchas gracias por contestar dante.
EL PROBLEMA ES EL SIGUIENTE COMO SE MUESTRA EN LA IMAGEN, el codigo que me ayudaste sale en el medio y no se ven los valores, al costado el archivo horizontal.txt. es como quisiera que se me muestre .
esperando su pronta respuesta y agradeciendo su tiempo , saludos cordiales
H o l a:
Te regreso la macro actualizada.
El dato del txt va a tomar el formato que tengas en la celda, es decir, si en la celda tienes 2 decimales, en el archivo te va a poner 2 decimales.
Sub GenerarTxt()
'Por.Dante Amor
ruta = ThisWorkbook.Path & "\"
rangos = Array("A1:B12", "C24:D32")
For r = LBound(rangos) To UBound(rangos)
FileNum = FreeFile()
Open ruta & "archivo " & r + 1 & ".txt" For Output As #FileNum
Set rango = Range(rangos(r))
numcol = rango.Columns.Count
'
For Each fila In rango.Rows
n = 1
For Each columna In fila.Columns
formato = Cells(fila.Row, columna.Column).NumberFormat
dato = Format(Cells(fila.Row, columna.Column), formato)
Print #FileNum, dato;
If n < numcol Then Print #FileNum, " ";
n = n + 1
Next
Print #FileNum,
Next
Close #FileNum
Next
'
MsgBox "Archivos txt generados", vbInformation, "GENERAR TXT"
End Sub
Buenas noches dante, muchísimas gracias por el tiempo que estas dándome, coloque el código y e presenta este error:
H o l a:
El detalle es que no tienes un formato de número en tus rangos.
Lo que tu tienes en tu celda es esto:
0
Y quieres que se vea en el archivo así:
0.00
O tienes en la celda esto:
.8
Y quieres que en el archivo se vea así:
0.80
Podemos generalizar y rellenar con 4 decimales todo, para que se vea así:
0.0000
0.8000
Después de todo, después del punto, los ceros a la derecha no cuentan.
Con la siguiente macro
Sub GenerarTxt()
'Por.Dante Amor
ruta = ThisWorkbook.Path & "\"
rangos = Array("A1:B12", "C24:D32")
For r = LBound(rangos) To UBound(rangos)
FileNum = FreeFile()
Open ruta & "archivo " & r + 1 & ".txt" For Output As #FileNum
Set rango = Range(rangos(r))
numcol = rango.Columns.Count
'
For Each fila In rango.Rows
n = 1
For Each columna In fila.Columns
dato = Format(Cells(fila.Row, columna.Column), "#0.0000")
Print #FileNum, dato;
If n < numcol Then Print #FileNum, " ";
n = n + 1
Next
Print #FileNum,
Next
Close #FileNum
Next
'
MsgBox "Archivos txt generados", vbInformation, "GENERAR TXT"
End SubEl resultado se vería así:
En la imagen puedes apreciar, en realidad en la celda tienes un 0 y la macro lo está formateando a 0.0000, lo mismo hace con el 0.4, en el archivo lo pone como 0.4000
Si quieres más decimales o menos decimales, cambia el número de ceros en la macro en esta instrucción:
dato = Format(Cells(fila.Row, columna.Column), "#0.0000")
Sal u dos
