Macro para generar archivo TXT con formato

[alexanderch]

Hola buenas tardes 

Gusto en saludarlos a tod@s 

Tengo la siguiente consulta a ver si me pueden ayudar, necesito una macro para generar archivo txt que me quede de la siguiente manera:

"06","0601017","477505,00000000","0,00"
"06","0601432","477505,00015784","0,50"
"06","0601662","477505,00000000","0,00"
"06","0601685","634499,73333333","0,00"

Al inicio me coloque las comillas " luego los separadores sea "," y al final cerrar con las comillas 

 

Mi archivo de excel  esta así

A         B                      C                     D

06  0601017  477505,00000000  0,00

06  0601432  477505,00015784  0,50

06  0601662  477505,00000000  0,00

06  0601685  634499,73333333  0,00

 

Atento a los comentarios de quienes me puedan ayudar 

 

Saludos 

 

 

[LeandroA]

Hola, con un click en un userform

Private Sub UserForm_Click()
    EscribirCVS "C:\MiArchivo.txt"
End Sub


Private Function EscribirCVS(ByVal sPath As String) As Boolean
    Dim FF As Integer
    Dim Row As Long, Col As Long
    Dim sLine As String
    
    FF = FreeFile
    Open sPath For Output As #FF
        
        For Row = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
            sLine = vbNullString
            For Col = 1 To ActiveSheet.UsedRange.Columns.Count
                sLine = sLine & Chr$(34) & ActiveSheet.Cells(Row, Col) & Chr$(34) & ","
            Next
            Print #FF, Left$(sLine, Len(sLine) - 1)
        Next
    Close #FF
    
    EscribirCVS = Err.Number = 0
    
End Function

 

[alexanderch]

Hola Gusto en saludar, gracias por la ayuda, pero estoy colocando la información de la macro y no me genera nada 

Atento a tus comentarios 

[Antoni]

Hace 1 hora, alexanderch dijo:

Hola Gusto en saludar, gracias por la ayuda, pero estoy colocando la información de la macro y no me genera nada 

Atento a tus comentarios 

Sube tu archivo.

[alexanderch]

No me permite subir el archivo por los permisos, pero investigando he logrado hacer uno 

Sub generarTXT()
    
    nombre_archivo = Range("H4").Value
    ruta = Range("H3").Value & "\" & nombre_archivo & ".txt"
    
    ultima_fila = Cells(Rows.Count, 4).End(xlUp).Row
    
    Open ruta For Output As #1
    
    For i = 3 To ultima_fila
    
        Print #1, Chr$(34) & Cells(i, 2).Value & Chr$(34) & "," & Chr$(34) & Cells(i, 3).Value & Chr$(34) & "," & Chr$(34) & Cells(i, 4).Value & Chr$(34) & "," & Chr$(34) & Cells(i, 5).Value&; Chr$(34)
    Next
    
    Close #1
    
    MsgBox (" se convirtió correctamente !")

End Sub

 

Pero me faltaría lograr hacer que los números decimales tome 9 decimales así terminen en cero (0)  ese es el  Cells(i, 4) tiene 9 decimales y la coma(,) la cambie por punto (.)  al igual que la data del Cells(i, 5) pero en ese son dos (2) decimales así sea en cero (0)

Es posible hacer esa modificación 

Atento a sus comentarios 

[Antoni]

Utiliza Cells(x,).Text en lugar de Cells(x,y).Value

[alexanderch]

Muchas gracias por la ayuda, solo faltaría que el formato en vez de coma sea punto en los decimales 

Me lo guarda de esta manera 

"06","0601017","477505,00000000","0,00"

y el correcto sería 

"06","0601017","477505.00000000","0.00"

Es posible.

[Antoni]

Replace(Cells(x, y).Text, ",", ".")

 

[alexanderch]

Increíble muchísimas gracias, por toda la ayuda prestada