Como exportar a txt quitando la primera fila y respetando la longitud de columnas

Cuanto con una macro que me exporta a txt con un botón, pero no quiero que me copie la primera fila y además quiero que respete la longitud de columnas

1 Respuesta

Respuesta
2

Puedes poner la macro que usas.

Y qué columnas quieres exportar y qué ancho de columna quieres poner, el mismo que tiene la columna en la hoja o tienes un tamaño definido para cada columna.

Dante, me puedes por favor proporcionar tu correo electronico para enviarte el archivo.

Actualmente cuando ejecuto la Macro me muestra Así (incluye la cabecera del archivo y no respeta los espacios de las columnas):

PERIODOEMPRESACODMODCARGOCARBENT_PLANICODDESMONTODESAPEPATERAPEMATERNOMBREFINICRE
2016061410406637051850010A2615500HERNANDEZBURGAHENRY20100101

Debería ser Así en ancho de caracteres:(PERIODO(6),EMPRESA(3),CODMOD(10),CARGO(6),CARBEN(4),T_PLANI(1),CODDES(4),MONTODES(8),APEPATER(40),APEMATER(40),NOMBRE(35),FINICRE(8))

20160601410406637051850010000A002600059725AGIP                                    SILVA                                   VICTOR IRRAEL                      20041203

La Macro es:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ExportToTextFile
' This exports a sheet or range to a text file, using a
' user-defined separator character.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ExportToTextFile(FName As String, Sep As String, SelectionOnly As Boolean, AppendData As Boolean)
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Application.ScreenUpdating = False
        On Error GoTo EndMacro:
        FNum = FreeFile
    If SelectionOnly = True Then
            With Selection
                StartRow = .Cells(1).Row
                StartCol = .Cells(1).Column
                EndRow = .Cells(.Cells.Count).Row
                EndCol = .Cells(.Cells.Count).Column
            End With
        Else
            With ActiveSheet.UsedRange
                StartRow = .Cells(1).Row
                StartCol = .Cells(1).Column
                EndRow = .Cells(.Cells.Count).Row
                EndCol = .Cells(.Cells.Count).Column
            End With
        End If
    Open FName For Output Access Write As #FNum
        For RowNdx = StartRow To EndRow
            WholeLine = ""
    For ColNdx = StartCol To EndCol
                If Cells(RowNdx, ColNdx).Value = "" Then
                    CellValue = Chr(34) & Chr(34)
                Else
                    CellValue = Application.WorksheetFunction.Text(Cells(RowNdx, ColNdx).Value, Cells(RowNdx, ColNdx).NumberFormat)
                End If
                WholeLine = WholeLine & CellValue & Sep
            Next ColNdx
            WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
            Print #FNum, WholeLine
        Next RowNdx
EndMacro:
        On Error GoTo 0
        Application.ScreenUpdating = True
        Close #FNum
    End Sub
    Sub test()
        ExportToTextFile ThisWorkbook.Path & "\test.txt", "", True
    End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END ExportTextFile
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DoTheExport
' This prompts the user for the FileName and the separtor
' character and then calls the ExportToTextFile procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub DoTheExport()
    Dim FileName As Variant
    Dim Sep As String
    FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
    If FileName = False Then
        ''''''''''''''''''''''''''
        ' user cancelled, get out
        ''''''''''''''''''''''''''
        Exit Sub
    End If
    Debug.Print "FileName: " & FileName, "Separator: " & Sep
    ExportToTextFile FName:=CStr(FileName), Sep:="", _
       SelectionOnly:=False, AppendData:=False
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END DoTheExport
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dante mi correo es: [email protected] , espero puedas escribirme para enviarte la macro, te agradecere mucho el apoyo brindado.

H o l a:

Envíame tu archivo de excel con la macro, en el archivo de excel debes poner un ejemplo de lo que quieras exportar; también me envías el archivo txt del resultado que esperas.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “HENRY EDINSON” y el título de esta pregunta.

Hola Dante,

Te informo que te envié los archivos solicitados a tu correo mailto:[email protected]  y espero puedas apoyarme. También aprovecho en felicitarte por los grandes aportes que vienes realizando. A la espera de tu pronta respuesta quedo de ti muy agradecido.

H o l a:

te anexo una nueva macro para lo que necesitas

Sub ExportarArchivo()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    '
    FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
    If FileName = False Then Exit Sub
    '
    ruta = l1.Path & "\"
    h1.Copy
    Set l2 = ActiveWorkbook
    Set h2 = l2.Sheets(1)
    cols = Array(6, 3, 10, 6, 4, 1, 4, 8, 40, 40, 35, 8)
    h2.Rows(1).Delete
    For i = LBound(cols) To UBound(cols)
        h2.Columns(i + 1).ColumnWidth = cols(i)
    Next
    l2.SaveAs FileName:=FileName, FileFormat:=xlTextPrinter, CreateBackup:=False
    l2.Close
    MsgBox "Archivo creado"
End Sub

' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Dante,

Agradezco infinitamente el apoyo brindado, todo funciona de maravillas gracias al gran aporte brindado.

Me siento alegre de saber que existen personas tan profesionales como tu, un fuerte abrazo a la distancia y gracias por brindar grandes aportes.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas