Exportar datos de excel por VBA

15/04/2004 - 03:08 por Jaime | Informe spam
Saludos nuevamente

el objetivo de la sig. macro listada es que me genere un
archivo de texto con ciertos espacios determinados hasta
ahora lo genera asi:

01/04/04 123456 11560.80 000 MOVTO ABRIL
02/04/04 123457 1230.60 000 MOVTO ABRIL
03/04/04 963145 950.80 000 MOVTO ABRIL

y lo necesito asi:

01/04/04 123456 11560.80 000 MOVTO ABRIL
02/04/04 123457 1230.60 000 MOVTO ABRIL
03/04/04 963145 950.80 000 MOVTO ABRIL

AGRADEZCO desde ya su apoyo..

Sub ExportarDelimitado()
Dim HojaPol As Worksheet
Dim intFich As Integer, lngNumReg As Long, strCad As
String, strCar As String * 1
Dim lngContL As Long, intContC As Integer, N As Long

Set HojaPol = Worksheets("polcont") 'Hoja donde están
los datos

intFich = FreeFile(0)
lngContL = 1 'Se empezará a exportar en la fila 2 (se
entiende que la 1ª es de títulos)
intContC = 6 'Se exportarán las columnas 1 a 6

If Dir("C:\Fichero.txt") <> "" Then Kill
("C:\Fichero.txt") 'Si ya existe C:\Fichero.txt, lo borra.
Open "C:\Fichero.txt" For Random As intFich Len = 1

While Not IsEmpty(HojaPol.Cells(lngContL, 1))

For N = 1 To intContC
strCad = strCad & Format(HojaPol.Cells
(lngContL, N), HojaPol.Cells(lngContL, N).NumberFormat)
& " "
Next N

strCad = Left(strCad, Len(strCad) - 1) &
vbNewLine 'Para quitar el último delimitador por la
derecha y añadir el salto de línea

For N = 1 To Len(strCad)
strCar = Mid(strCad, N, 1)
lngNumReg = lngNumReg + 1
Put intFich, lngNumReg, strCar
Next N

lngContL = lngContL + 1
strCad = ""
Wend

Close intFich

Set HojaPol = Nothing
End Sub
 

Leer las respuestas

#1 Héctor Miguel
15/04/2004 - 07:31 | Informe spam
hola, Jaime !

... objetivo ... genere un archivo de texto con ciertos espacios determinados [...]



[segun lo que se ve...] el 'detalle' esta en los =>espacios<= 'de separacion' entre las columnas 2 y 3
para 'llenar' con los espacios 'faltantes' entre un numero 'dado' y el largo de la columna 3
y [al parecer...] no encontraste 'como adaptar' la sugerencia de usar una sentencia String(15, " "-etc- [...]

una forma de 'aprovecharla' es la siguiente:
1° agrega/declara otra variable de tipo string para los espacios que 'separan' cada columna [p.e. strSpc]
2° 'intercepta' la columna 2 en el primer bucle ['For N = 1 To intContC'] y 'modifica' la cantidad de espacios 'finales'
que seran los que 'separen' las columnas 2 y 3 [con los espacios 'faltantes' segun el largo de la columna 3]
=> esto podrias hacerlo con una sentencia del tipo 'If...']

prueba con estas 'sugerencias' y tu macro ['adaptada'] quedaria +/- como sigue:
[obviamente, el archivo 'resultante' sera 'mejor visto' con un tipo de fuente de 'ancho fijo']
¿comentas?
saludos,
hector.
_____________________
Sub ExportarDelimitado()
Dim strSpc As String '<== la nueva variable propuesta
Dim HojaPol As Worksheet
Dim intFich As Integer, lngNumReg As Long, strCad As String, strCar As String * 1
Dim lngContL As Long, intContC As Integer, N As Long
Set HojaPol = Worksheets("polcont") 'hoja donde estan los datos
intFich = FreeFile(0)
lngContL = 1 'se empezara a exportar en la fila 2 (se entiende que la 1ª es de títulos)
intContC = 6 'se exportaran las columnas 1 a 6
If Dir("C:\Fichero.txt") <> "" Then Kill ("C:\Fichero.txt") 'si ya existe C:\Fichero.txt, lo borra.
Open "C:\Fichero.txt" For Random As intFich Len = 1
While Not IsEmpty(HojaPol.Cells(lngContL, 1))
For N = 1 To intContC
If intContC = 2 Then '<== el If 'interceptor' de la columna 2
strSpc = String(10 - Len(HojaPol.Cells(lngContL, N + 1)), " ") '<== 'habra' 10 espacios MENOS los que ocupe la col. 3
Else: strSpc = " " '<== para todos los demas casos, las columnas se separan por solo un espacio
End If
strCad = strCad & Format(HojaPol.Cells(lngContL, N), HojaPol.Cells(lngContL, N).NumberFormat) & strSpc '<== los 'necesarios'
Next N
strCad = Left(strCad, Len(strCad) - 1) & vbNewLine 'para quitar el ultimo delimitador por la derecha y añadir el salto de linea
For N = 1 To Len(strCad)
strCar = Mid(strCad, N, 1)
lngNumReg = lngNumReg + 1
Put intFich, lngNumReg, strCar
Next N
lngContL = lngContL + 1
strCad = ""
Wend
Close intFich
Set HojaPol = Nothing
End Sub

Preguntas similares