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,169

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,169

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

    • LASITO35
      porcentaje de avance %

      By LASITO35 · Posted

      saludos  esta perfecto tu ejemplo. me sirve de mucho. ahora otra duda como se podría aplicar este mismo ejemplo pero con los datos de una tabla dinámica. ya que esa formula es con celdas fijas.  pero como lo aplico a una tabla  para sacar el porcentaje de lo que he avanzado  si cuando actualizo la tabla me da error.  gracias   
    • LASITO35
      porcentaje de avance %

      By LASITO35 · Posted

      muchas  gracias  esta perfecto
    • Pirtrafilla
      Buscar valor en celda con varias condiciones

      By Pirtrafilla · Posted

      @Gerson PinedaMuchas gracias.  Os lo agradezco a los dos, me va a ir bien cualquiera de las fórmulas. Y sino en este fichero en otro con la misma situación. Moisés.
    • MAURO_1512
      Actualizar entradas y salidas de inventario

      By MAURO_1512 · Posted

      cuando grabas una entra o salida se redondea el numero en la existencia ejemplo si vendes 1.5 en existencia descuenta 2  igual si es una compra
    • Antoni
      boton para eliminar datos

      By Antoni · Posted

      Private Sub CommandButton11_Click() Dim Descarga As Range Set Descarga = Sheets("Hoja2").Columns("C").Find(TextBox2, lookat:=xlWhole) If Not Descarga Is Nothing Then Descarga.EntireRow.Delete CommandButton6_Click End If End Sub '--------- Private Sub CommandButton6_Click() TextBox2.Text = "" TextBox12.Text = "" TextBox13.Text = "" TextBox14.Text = "" TextBox15.Text = "" TextBox16.Text = "" TextBox17.Text = "" TextBox18.Text = "" TextBox19.Text = "" TextBox20.Text = "" TextBox23.Text = "" '<-------------------- estaba mal TextBox2.SetFocus ' EL SetFocus devuelve el cursor al inicio End Sub  

  • Recently Browsing

    No registered users viewing this page.

×
×
  • Create New...

Important Information

Privacy Policy

  I accept