none
Convertir bloc base de datos excel a bloc de notas RRS feed

  • Pregunta

  • Estimados, tengo un libro excel con los siguientes datos

    y quiero convertirlo en un archivo txt como este

    las condiciones son las siguientes:

    en el campo del bloc de notas tarjeta debe ser de 9 caracteres si es menor lo faltante se debe de completar con espacios.

    para hora es de 22 caracteres. para fecha es de 11 y para reloj es de 6.

    de esta forma el texto tomara el modelo que pongo en la imagen del bloc de notas.

    pense en hacer una aplicacion que me permita cargar el archivo excel a un datagridview y una vez cargado pasar todo ese datagriview a txt.

    lo que pasa es que no soy programador probe varios codigos en internet pero ninguno me ayuda.

    el ejemplo que di de la aplicacion es una idea si alguien sabe como hacerlo de forma mas sencilla la idea sera bien recibida.

    Pdt.: ya intente con macros en excel con guardar como texto unicode con exporar datos a txt y no me arroja el txt con el formato que deseo por eso pruebo con visual.

    • Cambiado Joyce_AC jueves, 15 de junio de 2017 13:55
    miércoles, 14 de junio de 2017 22:59

Respuestas

  • Hola espero te sirva esto

    1. En tu excel agrega un modulo para VBA
    2. Ve a herramientas/referencias/ Buscar "Microsoft Script Control 1.0"
    3. En tu módulo pega este código
    Sub ExportaHora()
    Dim fs As Object 'Objeto para crear un archivo
    Dim f As Object  'Archivo creado
    Dim ultimafila As Integer
    Cells(1, 1).Select
    ActiveCell.Offset(1, 0).Select
    Set fs = CreateObject("Scripting.FileSystemObject")   'Llama al objeto filesystem
    Set f = fs.CreateTextFile(ActiveWorkbook.Path & "\Tiempo.txt", True)  'Crea un objeto tipo texto en tu carpeta donde tienes tu excel
    ultimafila = Cells(Rows.Count, 1).End(xlUp).Row    'Lee la ultima fila

    'Chr(32) espacio
    'vbCrLf 'Salto de linea

        For a = 1 To ultimafila - 1
            Select Case Len(ActiveCell.Text)
            Case 9
                f.write ActiveCell.Text & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            Case 8
                f.write ActiveCell.Text & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            Case 7
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 6
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 5
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 4
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 3
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 2
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 1
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case Else
                f.write ActiveCell.Text & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            End Select
            ActiveCell.Offset(1, 0).Select
        Next
    f.Close
    End Sub
    1. Verifica tu resultado
    2. Si tienes alguna duda con gusto te ayudo

    Saludos

    • Marcado como respuesta eloshmt martes, 18 de julio de 2017 20:05
    sábado, 17 de junio de 2017 21:27

Todas las respuestas

  • No creo que puedas darle ese formato especifico, el rellenar con " " no es solución porque se movera la lina en el bloc, unicamente rellenar con "_" en Tarjetas y de allí partir.

     
    • Editado Marcelo PF jueves, 15 de junio de 2017 11:57
    jueves, 15 de junio de 2017 11:55
  • Hola espero te sirva esto

    1. En tu excel agrega un modulo para VBA
    2. Ve a herramientas/referencias/ Buscar "Microsoft Script Control 1.0"
    3. En tu módulo pega este código
    Sub ExportaHora()
    Dim fs As Object 'Objeto para crear un archivo
    Dim f As Object  'Archivo creado
    Dim ultimafila As Integer
    Cells(1, 1).Select
    ActiveCell.Offset(1, 0).Select
    Set fs = CreateObject("Scripting.FileSystemObject")   'Llama al objeto filesystem
    Set f = fs.CreateTextFile(ActiveWorkbook.Path & "\Tiempo.txt", True)  'Crea un objeto tipo texto en tu carpeta donde tienes tu excel
    ultimafila = Cells(Rows.Count, 1).End(xlUp).Row    'Lee la ultima fila

    'Chr(32) espacio
    'vbCrLf 'Salto de linea

        For a = 1 To ultimafila - 1
            Select Case Len(ActiveCell.Text)
            Case 9
                f.write ActiveCell.Text & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            Case 8
                f.write ActiveCell.Text & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            Case 7
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 6
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 5
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 4
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 3
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 2
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case 1
                f.write ActiveCell.Text & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            
            Case Else
                f.write ActiveCell.Text & Chr(32) _
                & ActiveCell.Offset(0, 1) & Chr(32) _
                & ActiveCell.Offset(0, 2) & Chr(32) _
                & ActiveCell.Offset(0, 3) & Chr(32) & vbCrLf
            End Select
            ActiveCell.Offset(1, 0).Select
        Next
    f.Close
    End Sub
    1. Verifica tu resultado
    2. Si tienes alguna duda con gusto te ayudo

    Saludos

    • Marcado como respuesta eloshmt martes, 18 de julio de 2017 20:05
    sábado, 17 de junio de 2017 21:27
  • exportalo como archivo csv en excel y pasale como separador el espacio y luego cambiale la extension a txt...
    domingo, 18 de junio de 2017 1:53
  • Gracias Armando, tu respuesta me ayudo a resolver el problema que tenia.
    martes, 18 de julio de 2017 20:05
  • Rolando, fue lo primero que intente pero no me resultaba.
    martes, 18 de julio de 2017 20:06