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
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 ' : )
- Compartir respuesta