Jump to content

Exportar datos de un listBox a un archivo .txt

Benito Bartolomé
 Share Followers 1
Go to solution Solved by Antoni,

Recommended Posts

Benito Bartolomé

Benito Bartolomé 10

Posted
Posted

Hola y buenos días a todos;

He empezado a crear una macro que me permite crear un archivo .txt pero no sé como continuar.

Quiero conseguir que los datos almacenados o filtrados  inclusive los que vaya seleccionando con el ratón en el listbox del frm_Cobros los pueda capturar y poder exportarlos al archivo .txt generado.

Adjunto macro y video:

https://youtu.be/bVO7f-JZuSg

Saludos.

 

ExportarTxt.zip

Link to post
Share on other sites
Benito Bartolomé

Benito Bartolomé 10

Posted
  • Author
Posted

He conseguido algo con este código pero me faltaría la segunda opción:

-Que pueda enviar los que seleccione con el ratón.

Adjunto código a ver si esta medianamente bien: 

Private Sub btn_Txt_Click(): On Error Resume Next
Dim ruta As String, I As Integer, existe As Boolean, coleccion_archivos As New Collection, archivo As String
    ruta = ActiveWorkbook.path
    archivo = Dir(ruta & "\*.*")
    Do Until archivo = ""
    coleccion_archivos.Add archivo
    archivo = Dir()
    Loop
    
    For I = coleccion_archivos.Count To 1 Step -1
        If coleccion_archivos(I) = "tb_Cobros.txt" Then
            existe = True
        End If
    Next I
    
        If existe = True Then
    Dim z As Integer
        z = MsgBox("Ya existe el archivo de texto.¿Deseas eliminardo?", vbYesNo)
        If z = vbYes Then
            Kill ActiveWorkbook.path & "\tb_Cobros.txt"
            existe = False
        Else
        
        Open ActiveWorkbook.path & "\tb_Cobros.txt" For Append As #1
        End If
        
   End If
   
   If existe = False Then
   
        Open ActiveWorkbook.path & "\tb_Cobros.txt" For Output As #1
            MsgBox "El archivo txt fue creado"
    End If
    Dim Sep As String
    Dim x
    Sep = ";"
    Print #1, "Fecha: " & Date
    
    For x = 0 To frm_Cobros.ListBox1.ListCount - 1
        TextBox0 = ListBox1.List(x, 0)
        TextBox50 = ListBox1.List(x, 1)
        TextBox51 = ListBox1.List(x, 2)
        TextBox4 = Format(ListBox1.List(x, 3), "dd/mm/yyyy")
        TextBox5 = ListBox1.List(x, 4)
        TextBox10 = ListBox1.List(x, 5)
        TextBox6 = ListBox1.List(x, 6)
        TextBox11 = ListBox1.List(x, 7)
        TextBox7 = ListBox1.List(x, 8)
        TextBox8 = ListBox1.List(x, 9)
        TextBox12 = ListBox1.List(x, 10)
    
    Print #1, TextBox0 & Sep & TextBox50 & Sep & TextBox51 & Sep & TextBox4 & Sep & TextBox5 & Sep & TextBox10 & Sep & TextBox6 & Sep & TextBox11 & Sep & TextBox7 & Sep & TextBox8 & Sep & TextBox12
    Next x
    Print #1, "-"
    
    Close #1
End Sub

 

Link to post
Share on other sites
Benito Bartolomé

Benito Bartolomé 10

Posted
  • Author
Posted

Buenas tardes;

-He conseguido algo con este código, imagino que se podrá mejorar .

-Si a alguno se le ocurre algo mejor que me lo diga.

Saludos. 

Private Sub btn_Txt_Click(): On Error Resume Next
Dim ruta As String, i As Integer, existe As Boolean, coleccion_archivos As New Collection, archivo As String
Dim Sep As String, x As Integer, z As Integer, Cuenta As Integer

    ruta = ActiveWorkbook.path
    archivo = Dir(ruta & "\*.*")
    Do Until archivo = ""
    coleccion_archivos.Add archivo
    archivo = Dir()
    Loop
    
    For i = coleccion_archivos.Count To 1 Step -1
        If coleccion_archivos(i) = "tb_Cobros.txt" Then
            existe = True
        End If
    Next i
    
If existe = True Then
z = MsgBox("Ya existe el archivo de texto.¿Deseas eliminardo?", vbYesNo)
    If z = vbYes Then
        Kill ActiveWorkbook.path & "\tb_Cobros.txt"
        existe = False
    Else
        Open ActiveWorkbook.path & "\tb_Cobros.txt" For Append As #1
    End If
        
End If
   
If existe = False Then
    Open ActiveWorkbook.path & "\tb_Cobros.txt" For Output As #1
    MsgBox "El archivo txt fue creado"
End If
    
    Cuenta = frm_Cobros.ListBox1.ListCount
    
    Sep = ";"
    Print #1, "Fecha: " & Date
    
    For x = 0 To Cuenta - 1
        If Me.ListBox1.Selected(x) = True Then
        MsgBox Me.ListBox1.List(x), vbInformation, "Registro"
        TextBox0 = ListBox1.List(x, 0)
        TextBox50 = ListBox1.List(x, 1)
        TextBox51 = ListBox1.List(x, 2)
        TextBox4 = Format(ListBox1.List(x, 3), "dd/mm/yyyy")
        TextBox5 = ListBox1.List(x, 4)
        TextBox10 = ListBox1.List(x, 5)
        TextBox6 = ListBox1.List(x, 6)
        TextBox11 = ListBox1.List(x, 7)
        TextBox7 = ListBox1.List(x, 8)
        TextBox8 = ListBox1.List(x, 9)
        TextBox12 = ListBox1.List(x, 10)
        Print #1, TextBox0 & Sep & TextBox50 & Sep & TextBox51 & Sep & TextBox4 & Sep & TextBox5 & Sep & TextBox10 & Sep & TextBox6 & Sep & TextBox11 & Sep & TextBox7 & Sep & TextBox8 & Sep & TextBox12
        End If
    Next x
    Print #1, "-"
    Close #1
End Sub

 

Link to post
Share on other sites
Antoni

Antoni 5,166

Posted
Posted

Esto: 

    If Dir(ActiveWorkbook.Path & "\tb_Cobros.txt") <> "" Then existe = True

Sustituye a esto: 

    ruta = ActiveWorkbook.Path
    archivo = Dir(ruta & "\*.*")
    Do Until archivo = ""
    coleccion_archivos.Add archivo
    archivo = Dir()
    Loop
    
    For i = coleccion_archivos.Count To 1 Step -1
        If coleccion_archivos(i) = "tb_Cobros.txt" Then
            existe = True
        End If
    Next i

 

Link to post
Share on other sites
Benito Bartolomé

Benito Bartolomé 10

Posted
  • Author
Posted

Bo día Antoni;

Me has simplificado mucho el código.👍

Con el código que a continuación insertaré consigo exportar los datos del listBox tanto si selecciono un item como varios u alternos.

Sólo me queda una duda por resolver y es:

-Como hago para poder exportar todos los datos cuando no selecciono ningún item. 

If Me.ListBox1.Selected(x) = True Then

Adjunto código: 

Private Sub btn_Txt_Click(): On Error Resume Next
Dim ruta As String, i As Integer, existe As Boolean
Dim Sep As String, x As Integer, z As Integer, Cuenta As Integer
Dim FechaCancel

If Dir(ActiveWorkbook.Path & "\tb_Cobros.txt") <> "" Then existe = True
    
If existe = True Then
z = MsgBox("Ya existe el archivo de texto.¿Deseas eliminardo?", vbYesNo)
    If z = vbYes Then
        Kill ActiveWorkbook.Path & "\tb_Cobros.txt"
        existe = False
    Else
        Open ActiveWorkbook.Path & "\tb_Cobros.txt" For Append As #1
    End If
        
End If
   
If existe = False Then
    Open ActiveWorkbook.Path & "\tb_Cobros.txt" For Output As #1
    MsgBox "El archivo txt fue creado"
End If
    
    Cuenta = frm_Cobros.ListBox1.ListCount
    FechaCancel = Date
    Sep = ";"
    For x = 0 To Cuenta - 1
        If Me.ListBox1.Selected(x) = True Then
        MsgBox Me.ListBox1.List(x), vbInformation, "Registro"
        TextBox0 = ListBox1.List(x, 0)
        TextBox50 = ListBox1.List(x, 1)
        TextBox51 = ListBox1.List(x, 2)
        TextBox4 = Format(ListBox1.List(x, 3), "dd/mm/yyyy")
        TextBox5 = ListBox1.List(x, 4)
        TextBox10 = ListBox1.List(x, 5)
        TextBox6 = ListBox1.List(x, 6)
        TextBox11 = ListBox1.List(x, 7)
        TextBox7 = ListBox1.List(x, 8)
        TextBox8 = ListBox1.List(x, 9)
        TextBox12 = ListBox1.List(x, 10)
        Print #1, "Fecha:" & FechaCancel & " " & TextBox0 & Sep & TextBox50 & Sep & TextBox51 & Sep & TextBox4 & Sep & TextBox5 & Sep & TextBox10 & Sep & TextBox6 & Sep & TextBox11 & Sep & TextBox7 & Sep & TextBox8 & Sep & TextBox12
        End If
    Next x
    Print #1, "-"
    Close #1
End Sub

Saúdos e moito coidado, la cosa se vuelve a poner seria.

Un abrazo y muchas gracias como siempre.

Link to post
Share on other sites
  • Solution
Antoni

Antoni 5,166

Posted
  • Solution
Posted

Te dejo una función para saber si hay algún elemento seleccionado. 

Private Function Seleccionado() As Boolean
Dim x As Long
For x = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(x) Then
      Seleccionado = True
      Exit Function
   End If
Next
End Function

Y luego basta con 

If ListBox1.Selected(x) Or Not Seleccionado Then

 

Link to post
Share on other sites
Benito Bartolomé

Benito Bartolomé 10

Posted
  • Author
Posted
Hace 40 minutos , Antoni dijo:

Te dejo una función para saber si hay algún elemento seleccionado. 


Private Function Seleccionado() As Boolean
Dim x As Long
For x = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(x) Then
      Seleccionado = True
      Exit Function
   End If
Next
End Function

Y luego basta con 


If ListBox1.Selected(x) Or Not Seleccionado Then

 

Perfecto maestro, eres un genio.

Lo intente con poner un segundo condicional  Select (x)= "False" y no había manera. 

Moitas pola axudiña. 

Te pondré un 10 de nota😃

Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share
Followers 1
Go to topic listing

  • Crear macros Excel

  • Posts

    • JUANJG
      EXTRAER DATOS DE SECCION CDATA DE XML

      By JUANJG · Posted

      Excelente, era lo que estaba buscando. Muchas graciaaaas
    • xinortiz
      ComboBox depende de otro ComboBox y llena ListBox

      By xinortiz · Posted

      Buenas tardes estimados amigos encontré un formulario navegando en internet que te agrega datos al listbox segun 2 condiciones en Combobox, lo malo esta en que el 2° combobox te repite los datos de la columna haber si alguien me puede ayudar con eso, que no se repitan los datos   muchas gracias Cuídense, Bendiciones... Combobox-Depende de otro Combobox y Llena ListBox.xlsm
    • ramonvar
      MsgBox

      By ramonvar · Posted

      Antoni Muchas gracias, por todo, paciencia y tiempo.. Damos por concluido este Tema
    • Antoni
      MsgBox

      By Antoni · Posted

      Debe ser la última línea del procedimiento CommandButton1_Click() inmediatamente antes de la sentencia End Sub
    • ramonvar
      MsgBox

      By ramonvar · Posted

      Antoni Lo puse entre todas estas Líneas, la que me enviaste, pero si existe igual me sale el mensaje, por que al poner Ej. 1026, que existe, me arroja el mensaje de que no existe, al poner Ej. 2024 que es uno que no existe en toda la base sale si el mensaje de forma correcta No se donde estaría mi ERROR!!! If buscar = "" Then Exit SubWith Worksheets("RUCs empresas").Range("D:D")Set esta = .Find(buscar, LookIn:=xlValues)If Not esta Is Nothing Thenprimeracelda = esta.Address Desde ya gracias por tu paciencia

  • Recently Browsing

    No registered users viewing this page.

×
×
  • Create New...

Important Information

Privacy Policy

  I accept