aporte para exportar TXT y solucion de duda con tabulaciones

08/05/2012 - 21:45 por gjes69 | Informe spam
Saludos y bendiciones,

escribo para ver quien pueda ayudarme con una duda, tengo el siguiente codigo para exportar los datos q tengo en mi hoja1 para un archivo txt, el cual ya he establecido ciertos parametros pero debo completar lo siguiente, el archivo txt no debe estar separado por tabulaciones, debera ser una linea entera donde cada columna es delimitada segun la posicion y tamaño q esta ocupe. ejemplo:

así es el archivo original en excel:

Rif: Nombre: numero de cuenta Monto: Codigo de factura:

J-29365705-9 MICRO SKY 01340363503631296334 BS 73.777,51 1695



así va con el código q adjunto:

J293657059 MICRO SKY 01340363503631296334 000007377751 0000001695



así debería quedar en el TXT

J293657059MICRO SKY 013403635036312963340000073777510000001695

rif empieza en la posicion 1 y tiene una longitud de 10caracteres,nombre debera empezar en la posicion 11 con una longitud de 35caracteres,numero de cuenta en la posicion 46 con una longitud de 20caracteres,monto en la posicion 67 con una longitud de 12caracteres,Codigo de factura en la posicion 79 con longitud de 10 caracteres. los simbolos como "-" "," "." y "BS" los remplase x espacios en blanco con el codigo adjunto y los espacios en blancos son rellenados con ceros en los casos de monto y codigo de factura..

alguien podria ayudarme a terminar este ultimo paso? alguna idea o aporte

Sub Exportando_TXT()
On Error Resume Next
'Ocultamos el procedimiento
Application.ScreenUpdating = False

'Cambiando los formatos para el TXT
'------------------
Range("A1").Select
'recorremos para abajo fila a fila,
'hasta encontrar una vacía
Do While Not IsEmpty(ActiveCell)
'reemplazamos simbolos por nada,
'o lo que es lo mismo, los quitamos
'siempre y cuando no estemos en una fórmula
If Left(ActiveCell.Formula, 1) <> "=" Then
ActiveCell = Replace(ActiveCell, "-", "")
End If
'bajamos una fila
ActiveCell.Offset(1, 0).Select
Loop
Range("D1").Select
'recorremos para abajo fila a fila,
'hasta encontrar una vacía
Do While Not IsEmpty(ActiveCell)
If Left(ActiveCell.Formula, 1) <> "=" Then
ActiveCell = Replace(ActiveCell, "BS", "")
ActiveCell = Replace(ActiveCell, ".", "")
ActiveCell = Replace(ActiveCell, ",", "")
End If
ActiveCell.Offset(1, 0).Select
Loop
'Defino el rango para los ceros a la izquierda segun formato
Range("C1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.NumberFormat = "@"
ActiveCell = Format(ActiveCell, "00000000000000000000")
ActiveCell.Offset(1, 0).Select
Loop

Range("D1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.NumberFormat = "@"
ActiveCell = Format(ActiveCell, "000000000000")
ActiveCell.Offset(1, 0).Select
Loop

Range("E1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.NumberFormat = "@"
ActiveCell = Format(ActiveCell, "0000000000")
ActiveCell.Offset(1, 0).Select
Loop
'------------------------------------
'copiamos la hoja activa en un nuevo libro

ActiveSheet.Copy
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
fichero = ThisWorkbook.Name
ruta = ThisWorkbook.Path
fichero = Replace(fichero, ".xlsx", "")
fichero = Replace(fichero, ".xls", "")
ActiveSheet.Select
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ruta & "\" & fichero & ".txt", FileFormat:=xlText
ActiveWorkbook.Close
Application.ScreenUpdating = True

End Sub
 

Preguntas similares