PROGRAMAR EN VBA MACROS PARA EXCEL: Como Exportar Desde Excel a TXT con Ancho Fijo Rellenando Campos con Ceros

Como Exportar Desde Excel a TXT con Ancho Fijo Rellenando Campos con Ceros






Macro de Excel que muestra Como Exportar a TXT con ancho fijo rellenando espacios en blanco con ceros, la macro exporta los datos de la hoja de Excel a TXT delimitados con un Ancho Fijo, en caso que los caracteres del campo sean menores al ancho establecido rellena los valores faltantes con cero.

Si estás trabajando con listbox quizás quieras aprender más sobre este objeto de VBA para Excel, en el link encontrarás muchos ejemplos que serán de utilidad relacionados con listbox de Excel.

Recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

Suscribe a nuestro canal para que YouTube te avise cuando se suba nuevo contenido al canal, en el vídeo encontrarás una explicación gráfica y detallada del ejemplo que se muestra en este post.






 


La macro que exporta de Excel a TXT con ancho fijo, en primer lugar determina el nombre del archivo con el que se va a guardar el TXT, que será el nombre del archivo con la macro y la extensión TXT, de la siguiente forma:

nom = ActiveWorkbook.Name
pto = InStr(nom, ".")
nomarch = Left(nom, pto - 1)
myfile = ThisWorkbook.Path & "\" & nomarch & ".txt"

Posteriormente se establece el ancho de las columnas, es decir que cantidad de caracteres debe contener cada campo, en este caso se establece el ancho fijo de casa columna, usando el siguiente código:

'largo de campos
larC1 = 5
larC2 = 10
larC3 = 50
larC4 = 50
larC5 = 15
larC6 = 10
larC7 = 15

Luego se establece el caracter con el cual se va a rellenar los espacios faltantes en caso que el dato contenido en cada campo sea menor al ancho establecido, así:

cara = "0" 'caracter para completar el espacio


⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como crear una factura con excel, guardarla y enviarla por mail automáticamente


Como enviar mail con archivo Excel y PDF mediante Outlook con Excel

Como hacer un link o hiperlink a google maps con Excel

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Se recorre con un bucle hasta la última fila con datos todas las filas de la hoja de Excel que se requiere exportar a TXT, concatenando el valor de cada campo con la cantidad de caracteres necesarios para llenar el ancho fijo establecido, de la siguiente forma:

C1 = String(larC1 - Len(Cells(i, 1)), cara) & Cells(i, 1)

Por último se concatenan todas las columnas y exporta a TXT con el siguiente código:

Print #1, C1 & C2 & C3 & C4 & C5 & C6 & C7

El ejemplo que permite exportar de Excel a TXT con ancho fijo rellenando espacios con cero se puede descargar del link del final, a continuación se muestra la codificación completa, sugiero ver el vídeo asociado para entender en forma más fácil el ejemplo.

Código que se inserta en un Módulo de Excel

'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********



#If VBA7 And Win64 Then
'Si es de 64 bits
Public Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
Public Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Public Declare PtrSafe Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Public Declare PtrSafe Function DrawMenuBar Lib "USER32" (ByVal hwnd As Long) As LongPtr
Public Declare PtrSafe Function RegOpenKeyA Lib "advapire32.dll" (ByVal hKey As LongPtr, ByVal lpSubKey As String, phkResult As LongPtr) As LongPtr
#Else
'Si es de 32 bits
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar Lib "USER32" (ByVal hwnd As Long) As Long
Public Declare Function RegOpenKeyA Lib "advapire32.dll" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
#End If

Sub ExportaTXTAnchoFijoRellenoCeros()
Dim i As Double
On Error Resume Next
Set a = Sheets("Hoja1")

'largo de campos
larC1 = 5
larC2 = 10
larC3 = 50
larC4 = 50
larC5 = 15
larC6 = 10
larC7 = 15
cara = "0" 'caracter para completar el espacio
uf = a.Range("A" & Rows.Count).End(xlUp).Row

Open myfile For Output As #1
For i = 2 To uf
C1 = String(larC1 - Len(Cells(i, 1)), cara) & Cells(i, 1)
C2 = String(larC2 - Len(Cells(i, 2)), cara) & Cells(i, 2)
C3 = Cells(i, 3) & String(larC3 - Len(Cells(i, 3)), cara)
C4 = Cells(i, 4) & String(larC4 - Len(Cells(i, 4)), cara)
C5 = String(larC5 - Len(Cells(i, 5)), cara) & Cells(i, 5)
C6 = String(larC6 - Len(Cells(i, 6)), cara) & Cells(i, 6)
C7 = String(larC7 - Len(Cells(i, 7)), cara) & Cells(i, 7)
Print #1, C1 & C2 & C3 & C4 & C5 & C6 & C7
Next i
Close
MsgBox ("El archivo txt se creo con éxito"), vbInformation, "AVISO"
End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends