Temas

Hola soy corlo

ahora en pantalla principal hay list1 y list2

en el list2 es donde se va entrando los articulos desde el formulario y en el list1 es donde se guardan los datos del list2 al list1 para poder sumar el contado y tarjeta de credito

A la hora de entrar los datos al list2 desde el formulario lo hace bien, el problema es para guardar todos los datos del list2 a una fila del list1 asi sucesivamente con numero de ticket 1,2,3, etc del list1


a la hora de guardar seria:Command2_click()

N de ticket, fecha y hora, metodo de pago, total en el list1


en el metodo de pago esta en la pantalla principal no desde el formulario




a la hora de leer seria list1_click()
N ticket, Fecha y hora, Producto, Precio Unitario, cantidad, subtotal, total, en el list2



Gracias

Hola soy colro

necesito sumar el total contado y el total tarjeta de credito
consigo sumar el total del list1
pongo el codigo

Código (vb) [Seleccionar] Expandir



Case 1  ' Leer fichero de facturación
            FrmFile.Show 1
            Dim h As Integer
             Dim totalcontado As Integer
                Dim totaltcredito As Integer
                totalcontado = 0: totaltcredito = 0
            If (Len(FrmFile.File) > 0) Then
                If (LeerFacturacion(App.Path & "\" & FrmFile.File) = True) Then
                    Call Activar(True)
                   
                    For h = 0 To List1.ListCount - 1
                   
                     If reg2.MetodoDePago = "0" Then
                     totalcontado = totalcontado + Val(Split(List1.List(h), vbTab)(6))
                    End If
                    If reg2.MetodoDePago = "1" Then
                    totaltcredito = totaltcredito + Val(Split(List1.List(h), vbTab)(6))
                    End If
                    Next h
                    txttotal.Text = Format(totalcontado, "#,##0.00")
                    Txttotal1.Text = Format(totaltcredito, "#,##0.00")
                   
                Else
                    Call Activar(False)
                End If
            End If









Gracias

Hola soy corlo

estoy haciendo una mini aplicacion de guardar datos de factura y leerlos por pantalla, en archivo secuencial.

guardar datos lo hace bien

el problema esta en leer los datos de la factura en pantalla
el archivo es 1.txt y hay lo siguiente:


==============================
           COMPROBANTE DE VENTA
==============================
TICKET Nº: 1                    TIPO : CONTADO
FECHA : 20/11/2021          HORA : 20:30:59
-------------------------------------------------------
R.U.C/C.I : a
CLIENTE   : a
===============================
CANTIDAD  PRODUCTO     PRECIO       SUBTOTAL
===============================
12               r              8          96
3              k              1.5        4,5
===============================
              TOTAL :                           100,50
               -------------------------------------------

          GRACIAS POR SU COMPRA!



me sale todo mezclado


el código que tengo hasta ahora es el siguiente:

Código (vb) [Seleccionar] Expandir



Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_SETTABSTOPS = &H192
Dim I As Integer
Dim orden As Integer 'numero de ticket
Dim fecha As Date 'para leer la fecha
Dim hora As Date 'para leer la hora
Dim contado As String 'para contado
Dim credito As String 'para  credito
Dim cedu1 As String ' para el RUC/C.I
Dim nom1 As String ' para el cliente
'abajo son datos del list1
Dim cantidad As Integer
Dim producto As String * 12
Dim preciox As String * 8
Dim subtot As Double
'varible del total
Dim tot As Double
Private Sub Command4_Click()
End
End Sub

Private Sub Command5_Click()
'Nuevo registro
'//recuperar el dato.
Open App.Path & "\Numero1.txt" For Input As #1
Do While Not EOF(1)
Input #1, orden
Loop
Close #1
Txtnum = orden + 1



      List1.Clear
     txtCedula1.Text = ""
     txtNombre1.Text = ""
     total.Text = ""
     txtCedula1.SetFocus


End Sub



Private Sub Command6_Click()
'Guardar Factura

Dim cantidadtotal As Double
Dim k As Integer


orden = Txtnum.Text
On Error GoTo salir





    Open App.Path & "\Numero1.txt" For Append As #1
   
    Print #1, Txtnum
    Close #1

Dim bmx As String
bmx = App.Path + "\" + Txtnum + ".txt"
   
  Open bmx For Append As #1
 
 
  Txtnum = orden
 
 
   
    Print #1,
   
    Print #1,
   
    Print #1,
   

    Print #1, Tab(1); String(44, "=")
    Print #1, Tab((44 - Len("COMPROBANTE DE VENTA")) \ 2); "COMPROBANTE DE VENTA"
    Print #1, Tab(1); String(44, "=")

    If Option1.Value = True Then
        Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CONTADO")); "TIPO : CONTADO"
    Else
        Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CREDITO")); "TIPO : CREDITO"
    End If

    Print #1, Tab(1); "FECHA : " & Date; Tab(44 - Len("HORA : " & Time)); "HORA : " & Time

    Print #1, Tab(1); String(44, "-")

    Print #1, Tab(1); "R.U.C/C.I : " & txtCedula1.Text
    Print #1, Tab(1); "CLIENTE   : " & txtNombre1.Text

    Print #1, Tab(1); String(44, "=")
    Print #1, Tab(1); "CANTIDAD"; Tab(11); "PRODUCTO"; Tab(24); "PRECIO"; Tab(37); "SUBTOTAL"
    Print #1, Tab(1); String(44, "=")
   
   
For k = 0 To List1.ListCount - 1
Print #1, List1.List(k)
Next k



    Print #1, Tab(1); String(44, "=")
    Print #1, Tab(15); "TOTAL : "; Tab(43 - Len(Format(total.Text, "#,##0.00"))); Format(total.Text, "#,##0.00")
    Print #1, Tab(16); "-----------------------------"


   
    Print #1,
    Print #1, Tab((44 - Len("GRACIAS POR SU COMPRA!")) \ 2); "GRACIAS POR SU COMPRA!"

    For I = 1 To 10
        Print #1,
    Next I
           
    Close #1
   
   
  Option1.Value = False
Option2.Value = False
       
txtCedula1.Text = ""
txtNombre1.Text = ""
    List1.Clear
cant.Text = ""
prod.Text = ""
precio.Text = ""
subtotal.Text = ""
total.Text = ""
cant.SetFocus
   
    Exit Sub

salir:

Dim msgb

msgb = MsgBox("Error Nº : [ " & Err.Number & " ]" & " " & Err.Description, vbOKCancel + vbInformation)


End Sub



Private Sub Command7_Click()
'Leer Factura
Dim tabs(0 To 3) As Long
    tabs(0) = 20
    tabs(1) = 60
    tabs(2) = 95
    tabs(3) = 138
    ' Set the tabs.
    SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1)



Dim str As String
Dim thj As String
Dim plo As Boolean
Dim j As Integer
Dim h As Integer
On Error GoTo lo
List1.Clear
thj = App.Path + "\" + Txtnum.Text + ".txt"
If Dir(thj) <> "" Then
Open thj For Input As #1

Input #1, orden
Txtnum.Text = orden
Input #1, fecha
Label4.Caption = fecha
Input #1, hora
Label5.Caption = hora
Input #1, contado
Input #1, credito

Input #1, cedu1, nom1

txtCedula1.Text = cedu1
txtNombre1.Text = nom1

While Not EOF(1)

Input #1, cantidad, producto, preciox, subtot
cant.Text = cantidad
prod.Text = producto
precio.Text = preciox
subtotal.Text = subtot
List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot
Wend

j = 0
   For h = 0 To List1.ListCount - 1
j = j + Val(Split(List1.List(h), vbTab)(3))
Next h
total.Text = j



Close #1
End If

If contado= contado Then
Option1.Value = True
Else

If credito = credito Then
Option2.Value = True

End If
End If





Exit Sub
lo:
If Not plo = True Then
MsgBox "La Factura no existe, gracias", vbCritical
End If
End Sub

Private Sub Command8_Click()
'Agregar
Dim h As Integer
Dim j As Double

cantidad = cant.Text
producto = prod.Text
preciox = precio.Text
subtot = subtotal.Text

List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot
j = 0
   For h = 0 To List1.ListCount - 1
j = j + Split(List1.List(h), vbTab)(3)
Next h
total.Text = Format(j, "#,##0.00")
cant.Text = ""
prod.Text = ""
precio.Text = ""
subtotal.Text = ""
cant.SetFocus
End Sub

Private Sub Form_Load()
Dim tabs(0 To 3) As Long

    tabs(0) = 20
    tabs(1) = 123
    tabs(2) = 237
    tabs(3) = 370
   
    SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1)
   
Option1.Value = False
Option2.Value = False
   
Open App.Path & "\Numero1.txt" For Append As #1
Close #1
Open App.Path & "\Numero1.txt" For Append As #1
Close #1

'//recuperar el dato.
Open App.Path & "\Numero1.txt" For Input As #1
Do While Not EOF(1)
Input #1, orden
Loop
Close #1
Txtnum = orden + 1

End Sub

Private Sub List1_Click()
Text1.Text = Mid(List1.Text, 1, InStr(1, List1.Text, " ") - 1)
Text2.Text = Mid(List1.Text, InStr(1, List1.Text, " ") + 1)
I = List1.ListIndex
End Sub






Private Sub Option1_Click()
Option2.Value = False
End Sub

Private Sub Option2_Click()
Option1.Value = False
End Sub

Private Sub precio_KeyUp(KeyCode As Integer, Shift As Integer)
subtotal.Text = cant.Text * Val(precio.Text)
End Sub

Private Sub Timer1_Timer()
Label4.Caption = Date
Label5.Caption = Format(Time, "hh:mm:ss")
End Sub







Gracias

Hola soy corlo
estoy haciendo una mini aplicacion en añadir datos a los textbox ,  para luego leer los datos con el combo y una opcion para eliminar los datos.

añadir los datos: lo hace bien
leer los datos: lo hace bien
eliminar los datos: elimina el dato en el combo pero no elimina los datos de los textbox
no se que hago mal
paso el codigo que tengo hasta ahora

en un formulario

Código [Seleccionar] Expandir



Option Explicit


Private Sub Boton_añadir_Click()
totalregistros = totalregistros + 1
If totalregistros > 50 Then
MsgBox "lista completa", 16, "error"
Else
agenda(totalregistros).Nombre = Nom.Text
agenda(totalregistros).apellidos = Ape.Text
agenda(totalregistros).telefono = Tel.Text
agenda(totalregistros).Edad = Val(Edad.Text)

Combo2.AddItem Nom.Text
End If
Nom.SetFocus
End Sub

Private Sub Boton_eliminar_Click()
Dim b As String

b = MsgBox("Eliminar Registro:" + Nom.Text, 3 + 32, "Eliminar")
If b = vbYes Then



If Combo2.ListIndex <> -1 Then




Combo2.RemoveItem (Combo2.ListIndex)



End If

totalregistros = totalregistros - 1

agenda(totalregistros).Nombre = Nom.Text
agenda(totalregistros).apellidos = Ape.Text
agenda(totalregistros).telefono = Tel.Text
agenda(totalregistros).Edad = Val(Edad.Text)





End If
Nom.Text = ""
Ape.Text = ""
Tel.Text = ""
Edad.Text = ""
End Sub

Private Sub Boton_fin_Click()
End
End Sub





Private Sub Botonnuevo_Click()
Nom.Text = ""
Ape.Text = ""
Tel.Text = ""
Edad.Text = ""
Nom.SetFocus

End Sub





Private Sub Combo2_Click()
Dim n As Integer
n = Combo2.ListIndex + 1

Nom.Text = agenda(n).Nombre
Ape.Text = agenda(n).apellidos
Tel.Text = agenda(n).telefono
Edad.Text = Val(agenda(n).Edad)



End Sub

Private Sub Ape_GotFocus()
Ape.SelStart = 0
Ape.SelLength = Len(Ape.Text)
End Sub

Private Sub Edad_GotFocus()
Edad.SelStart = 0
Edad.SelLength = Len(Edad.Text)
End Sub

Private Sub Nom_GotFocus()
Nom.SelStart = 0
Nom.SelLength = Len(Nom.Text)
End Sub
Private Sub Tel_GotFocus()
Tel.SelStart = 0
Tel.SelLength = Len(Tel.Text)
End Sub



Private Sub Form_Load()
totalregistros = 0
End Sub








y en un modulo

Código [Seleccionar] Expandir



Type registro
Nombre As String * 15
apellidos As String * 25
telefono As String * 15
Edad As String * 3
End Type
Global agenda(1 To 50) As registro
Global totalregistros As Integer










gracias

Hola soy  corlo


estoy haciendo un pequeño programa necesito descontar el valor que le pongo en el  text3.text
y lo cambie en el valor seleccionado del list1 de la columna 3


en el programa hay los siguientes objetos:

1 list1
1 list2

text1.text
text2.text
text3.text

1 command1 salida
1 command4 ok

la cuestion es que cuando aprieto el command1 la operacion de resta lo hace bien, cuando voy a el command4 no consigo poner el resultado del text3.text  en el list1 del valor seleccionado de la columna 3

aqui esta el codigo que tengo hasta ahora:

Código [Seleccionar] Expandir




Option Explicit






Private Sub Command1_Click()
'salida ok


Dim i As Long
Dim arrString() As String
For i = 0 To UBound(arrString)
    List1.AddItem arrString(i)
Next

End Sub

Private Sub Command3_Click()
Unload Me
Form1.Show
End Sub

Private Sub Command4_Click()
'Salida
Dim cantidad As Integer
cantidad = Text1.Text

If Text3.Text > cantidad Then
   MsgBox "No hay suficiente existencia", vbCritical
   Exit Sub
End If

Command1.Visible = True
Text3.Text = Text3.Text - Text1.Text
End Sub

Private Sub Form_Load()
List1.AddItem "p001" & "                     " & "descripciom p001" & "                           " & "42"
List1.AddItem "p002" & "                     " & "descripciom p002" & "                           " & "53"
List1.AddItem "p003" & "                     " & "descripciom p003" & "                           " & "244"
List1.AddItem "p004" & "                     " & "descripciom p004" & "                           " & "75"
Text2.Text = List1.ListCount
Command1.Visible = False
End Sub

Private Sub List1_Click()

    Dim x As Integer
  List2.Clear
   
  List2.AddItem List1.Text

    For x = 0 To List2.ListCount - 1
   
   Text1.Text = Mid(List2.List(x), Len(List2.List(x)) - 2, 3)

   
   Next x
   
   
End Sub







he probado varias formas pero no consigo cambiar el valor del text3 al list1

gracias

Hola soy corlo
tengo el siguiente problema

cuando pongo lo siguiente en el apartado leer user y password

Text1.Text = Access.uname
Text2.Text = Access.passwd

el problema es cuando estoy leyendo el user y password introduzca datos diferentes en el text1.text y el text2.text , y pongo los datos que hay en fichero  siempre me dice bienbenido y va al form2

en cambio cuando quito


Text1.Text = Access.uname
Text2.Text = Access.passwd


siempre me dice El archivo no existe


Aqui pongo el codigo

Código [Seleccionar] Expandir



Option Explicit
Private Type Authorize
    uname As String * 30
    passwd As String * 30
End Type

Dim Pos As Integer
Dim Cont As Integer
Dim Fnum As Integer






Private Sub Command1_Click()
'Guardar
Dim Access As Authorize


Fnum = FreeFile
Access.uname = Text1.Text
Access.passwd = Text2.Text
Open App.Path & "\members1.dat" For Random As #Fnum Len = Len(Access)
    Cont = LOF(Fnum) / Len(Access)


Pos = Cont + 1
Put Fnum, Pos, Access

MsgBox "Nuevo Usuario Añadido: " & Access.uname & Access.passwd

Close #Fnum
End Sub

Private Sub Command2_Click()
'leer
Dim Access As Authorize

    Fnum = FreeFile

Open App.Path & "\members1.dat" For Random As #Fnum Len = Len(Access)
    Cont = LOF(Fnum) / Len(Access)

For Pos = 1 To Cont

   Get #Fnum, Pos, Access



   
   
Next
Text1.Text = Access.uname
Text2.Text = Access.passwd

Close #Fnum



   If Text1.Text = "" And Text1.Text <> Access.uname And Text2.Text <> Access.passwd Then
MsgBox "El archivo no existe", vbCritical, "No existe"
Text1.Text = ""
Text2.Text = ""
Exit Sub
End If

If Text1.Text = Access.uname Or Text2.Text = Access.passwd Then
MsgBox "Bienvenido", vbInformation
Form2.Show
Me.Hide
End If











End Sub

Private Sub Command3_Click()
End
End Sub


Private Sub Command4_Click()
Text1.Text = ""
Text2.Text = ""
Text1.SetFocus
End Sub












la pregunta seria:

como solucionar el tema de los avisos en el apartado leer

1. para ir al formulario dos

2. para el registro no existe


Gracias

Hola soy Corlo
Mi problema es el siguiente:
Cuando lo hago por pantalla me lo hace bien

en un commandbutton1

Código [Seleccionar] Expandir



DrawWidth = 5
DrawStyle = 2

Line (950, 2950)-(12000, 2950)





Pero cuando lo hago por impresora, no me  hace nada

intento hacer esto:

Código [Seleccionar] Expandir






DrawWidth = 5
DrawStyle = 2




Printer.Line (950, 2950)-(12000, 2950)




Printer.EndDoc






pero no sale, he buscado por internet y no encuentro la solucion, gracias

Hola soy corlo
tengo una duda para imprimir list1

el codigo que tengo hasta ahora es el siguiente

Código [Seleccionar] Expandir




Private Sub Command7_Click()
' Imprimir
Dim total As String
Dim total1 As String
Dim total2 As String
Dim i As Integer

Dim factura As Integer

ReDim lbtab(1 To 4) As Long

lbtab(1) = 31
lbtab(2) = 141
lbtab(3) = 278
lbtab(4) = 478
SendMessageArray List1.hwnd, LB_SETTABSTOPS, 4, lbtab(1)

total = Label5.Caption
total1 = Label6.Caption
total2 = Label7.Caption

Printer.FontSize = 18

Printer.CurrentX = 3100
Printer.CurrentY = 0
Printer.Print "Factura Nº:"
Printer.CurrentX = 5000
Printer.CurrentY = 0
Printer.Print Txtnum.Text


Printer.CurrentX = 1000
Printer.CurrentY = 3000
Printer.Print "Cantidad"
Printer.CurrentX = 3500
Printer.CurrentY = 3000
Printer.Print "Producto"
Printer.CurrentX = 7350
Printer.CurrentY = 3000
Printer.Print "Precio"
Printer.CurrentX = 9900
Printer.CurrentY = 3000
Printer.Print "Subtotal"


For i = 0 To List1.ListCount - 1
List1.ListIndex = i

Printer.Print List1.List(i)
Next


List1.Clear

Printer.CurrentX = 8400
Printer.CurrentY = 10000
Printer.Print "Subtotal:"
Printer.CurrentX = 9300
Printer.CurrentY = 10500
Printer.Print "iva:"
Printer.CurrentX = 9000
Printer.CurrentY = 11000
Printer.Print "Total:"

Printer.CurrentX = 10000
Printer.CurrentY = 10000
Printer.Print total
Printer.CurrentX = 10000
Printer.CurrentY = 10500
Printer.Print total1
Printer.CurrentX = 10000
Printer.CurrentY = 11000
Printer.Print total2


Printer.Print









Printer.EndDoc



End Sub





la impresion lo hace bien


como puedo hacer las separaciones del list1 a la hora de imprimir las columnas
el list1 tiene 4 columnas

ReDim lbtab(1 To 4) As Long

lbtab(1) = 31
lbtab(2) = 141
lbtab(3) = 278
lbtab(4) = 478
SendMessageArray List1.hwnd, LB_SETTABSTOPS, 4, lbtab(1)

Hola soy corlo
estoy haciendo un pequeño codigo de imagenes aleatorias, que apretando un command1
me va generando una imagen aleatoria, funciona perfectamente ahora lo que quiero es
que con otro boton command2 me haga todas las imagenes aleatorias  seguidas mediante un intervalo de tiempo.
en el formulario hay :
filelistbox=archivos
image1
el codigo es el siguiente:

Código [Seleccionar] Expandir



Private Sub Command1_Click()
Dim aleatorio As Integer
aleatorio = Int(((archivos.ListCount - 1) * -1) * Rnd + archivos.ListCount - 1)
Image1.Picture = LoadPicture(App.Path + "\imagenes\" + archivos.List(aleatorio))
End Sub

Private Sub Form_Load()
archivos.Path = App.Path + "\imagenes\"
End Sub




gracias

Hola soy corlo
estoy haciendo un codigo para leer el final del archivo del indice o sea text6.text
text6.text=contador
text1.text=azar
text2.text=azar1
text3.text=azar2
text3.text=azar3
text4.text=azar4

a la hora de grabar la informacion me lo hace bien, pero cuando cierro el programa y lo ejecuto
otra vez me dice el siguiente error en el form load

Error '62' en tiempo de ejecucion:
la entrada de datos se ha sobrepasado el final del archivo
en la linea:
Input #1, azar, azar1, azar2, azar3, azar4


y lo que yo quiero es leer la variable contador al final del archivo

Código [Seleccionar] Expandir





Dim contador As Integer
Dim azar As Integer
Dim azar1 As Integer
Dim azar2 As Integer
Dim azar3 As Integer
Dim azar4 As Integer

Private Sub Command1_Click()
'Nuevo
Text6.Text = contador + 1
contador = contador + 1
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""


End Sub

Private Sub Command2_Click()

'Guardar

    Open App.Path & "\azar" & ".txt" For Append As #1
    Print #1, Text6.Text & vbCrLf
    Print #1, Text1.Text, Text2.Text, Text3.Text, Text4.Text, Text5.Text & vbCrLf
    Close #1


End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Command5_Click()
' Calcular

Randomize
azar = Int(Rnd * 45) + 1
Text1.Text = azar
azar1 = Int(Rnd * 45) + 1
Text2.Text = azar1
azar2 = Int(Rnd * 45) + 1
Text3.Text = azar2
azar3 = Int(Rnd * 45) + 1
Text4.Text = azar3
azar4 = Int(Rnd * 45) + 1
Text5.Text = azar4
End Sub

Private Sub Form_Load()
If contador = 0 Then
Open App.Path & "\azar" & ".txt" For Append As #1
Close #1
End If
If contador = 0 Then contador = 1
Open App.Path & "\azar" & ".txt" For Input As #1
     While Not EOF(1)
     Input #1, contador
     Input #1, azar, azar1, azar2, azar3, azar4

en el segunda lectura me pone el siguiente error:
Error '62' en tiempo de ejecucion:
la entrada de datos se ha sobrepasado el final del archivo


     Wend
      Close #1
Text6.Text = contador
End Sub









Gracias

Hola soy corlo
modificar datos de text1,text2 a list1 del formulario 2 al formulario 1
leer datos de list1 a text1, text2 del formulario 1 al formulario 2

aqui dejo el codigo que tengo hasta ahora

en el formulario1

Código [Seleccionar] Expandir



Private Sub Form_Load()
List1.AddItem "jorge" & "               " & "Ramirez"
List1.AddItem "luis" & "                " & "Rodriguez"
List1.AddItem "pedro" & "               " & "Gonzalez"

End Sub



Private Sub List1_DblClick()

'Form2.Text1.Text = List1.List(List1.ListIndex)

Dim i As Integer

Form2.Text1.Text = Mid(List1.Text, 1, InStr(1, List1.Text, " ") - 1)
Form2.Text2.Text = Mid(List1.Text, InStr(List1.Text, " ") + 16)
i = List1.ListIndex
   

Form2.Show
End Sub










y en el formulario 2  esto

Código [Seleccionar] Expandir




Private Sub Command1_Click()
Form1.List1.List(Form1.List1.ListIndex) = Form2.Text1.Text
Form1.List1.List(Form1.List1.ListIndex) = Form2.Text2.Text
Unload Me
End Sub








no logro hacer la modificacion del formulario 2 al formulario 1
gracias

hola soy corlo
tengo un pequeño problema a la hora de pasar informacion de un archivo de texto ,  combo1 tengo los 12 meses, y cuando selecciono un mes vaya leyendo en list1.

en el formulario hay un combo1, y un list1

en el list1 hay lo iguiente:

en el dia 1/1/2020

1       1/1/2020                a
1       1/1/2020                b
1       1/1/2020                c
4       1/1/2020                d
5       11/12/2018                e

en dia 2/1/2020

5       2/1/2020                f
7       2/1/2020                g
8       2/1/2020                h
9       2/1/2020                i

en dia 3/1/2020

10      3/1/2020               o
11      3/1/2020               p
12      3/1/2020               s

y este el codigo:

Código [Seleccionar] Expandir



Option Explicit
Dim g As Integer
Dim i As Integer
Dim fencontrada As Boolean

Private Sub Combo1_Click()
Dim f_Canal As Long
On Error GoTo plo
fencontrada = False
List1.Clear
Select Case Combo1.Text
Case "enero":
g = 0
Call BuscarItems(List1.List(List1.ListIndex))

Case "febrero":
g = 1
Call BuscarItems(List1.List(List1.ListIndex))


Case "marzo":
g = 2
Call BuscarItems(List1.List(List1.ListIndex))


Case "abril":
g = 3
Call BuscarItems(List1.List(List1.ListIndex))


Case "mayo":
g = 4
Call BuscarItems(List1.List(List1.ListIndex))

Case "junio":
g = 5
Call BuscarItems(List1.List(List1.ListIndex))



Case "julio":
g = 6
Call BuscarItems(List1.List(List1.ListIndex))


Case "agosto":
g = 7
Call BuscarItems(List1.List(List1.ListIndex))


Case "septiembre":
g = 8
Call BuscarItems(List1.List(List1.ListIndex))

Case "octubre":
g = 9
Call BuscarItems(List1.List(List1.ListIndex))



Case "noviembre":
g = 10
Call BuscarItems(List1.List(List1.ListIndex))


Case "diciembre":
g = 11
Call BuscarItems(List1.List(List1.ListIndex))



End Select



plo:
If Not fencontrada Then
    MsgBox "El Mes " & Combo1.Text & " no existe."
    Combo1.Text = ""
   Close f_Canal

End If
End Sub



Private Sub Form_Load()
Combo1.Clear
Combo1.AddItem "enero"
Combo1.AddItem "febrero"
Combo1.AddItem "marzo"
Combo1.AddItem "abril"
Combo1.AddItem "mayo"
Combo1.AddItem "junio"
Combo1.AddItem "julio"
Combo1.AddItem "agosto"
Combo1.AddItem "septiembre"
Combo1.AddItem "octubre"
Combo1.AddItem "noviembre"
Combo1.AddItem "diciembre"
End Sub


Private Sub BuscarItems(ByVal strFecha As String)
    Dim item As String
Dim f_Canal As Long
   

    With file
        Text1.Text = CStr(.Id)
        Text2.Text = CStr(.Date)
        Text3.Text = CStr(.Name)
    End With
Open App.Path & "\database.txt" For Random As f_Canal Len = Len(file)
    Seek (f_Canal), 1     ' posicionar el puntero de lectura al comienzo del fichero (en vb6 es la dirección 1).
    Do While Not EOF(f_Canal)
        Get f_Canal, , file
        With file
            If (StrComp(strFecha, CStr(.date), vbTextCompare) = 0) Then
                item = FormatStr(CStr(.id), 4, True)
                item = FormatStr(item, 12) & _
                       FormatStr(CStr(.date), 16) & _
                       FormatStr(.name, 40)
            Call List1.AddItem(item)
            End If
        End With
    Loop
    Close f_Canal
End Sub

Private Function FormatStr(ByRef Txt As String, ByVal Limite As Integer, Optional ByVal EsNumero As Boolean = False)

    If EsNumero Then
        FormatStr = FormatNumber(Txt, Limite)
    Else
        FormatStr = FormatString(Txt, Limite)
    End If
End Function

' Asegura que el texto tenga por tamaño exactamente el valor de límite
' Si es más corto añade espacios a la derecha.
Private Function FormatString(ByRef Txt As String, ByVal Limite As Integer) As String
    Dim k As Integer
Dim maximo As Integer
    k = Len(Txt)
    k = (Limite - k)
    If (k > 0) Then
        FormatString = Txt & Space$(k)
    ElseIf (k < 0) Then
        FormatString = Left$(Txt, maximo)
    Else
        FormatString = Txt
    End If
End Function

'Asegura que el texto tenga por tamaño exactamente el valor de límite
' OJO: Si es más corto añade 'ceros' a la izquierda.
Private Function FormatNumber(ByRef Txt As String, ByVal Limite As Integer) As String
    Dim k As Integer

    k = Len(Txt)
    k = (Limite - k)
    If (k > 0) Then
       FormatNumber = String$(k, "0") & Txt
    ElseIf (k < 0) Then
        FormatNumber = Left$(Txt, Limite)
Else
        FormatNumber = Txt
    End If
End Function



y en un modulo:

Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task









gracias

Hola soy Corlo
necesito una ayuda para el siguiente tema
La cuestion es que el siguiente programa que he hecho funciona correctamente, pero el problema que hay es que cuando pasa un dia entero que cambie el contador de n=1 en la caja de texto text1.text y que vaya sumando el contador correlativamente
dejo el codigo

Código [Seleccionar] Expandir



Option Explicit
Dim n As Integer



Private Sub Command1_Click()
'Nuevo
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)


n = LOF(1) / Len(file)

Get #1, n, file
Text1.Text = n + 1
Close #1

Text2.Text = Format(date, "dd/mm/yyyy")
Text3.Text = ""
Text3.SetFocus
End Sub

Private Sub Command2_Click()
'Guardar
file.id = Text1.Text
file.date = Text2.Text
file.name = Text3.Text

Open App.Path & "\database.txt" For Random As 1 Len = Len(file)

n = LOF(1) / Len(file)
Put #1, n + 1, file
Close #1
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Command4_Click()
Unload Me
Form2.Show
End Sub

Private Sub Form_Load()
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)

n = LOF(1) / Len(file)

Get #1, n, file
Text1.Text = n + 1

Close #1

Text2.Text = Format(date, "dd/mm/yyyy")
End Sub









y en un modulo

Código [Seleccionar] Expandir



Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task









Gracias

hola soy corlo
quisiera hacer un pdf del siguiente codigo

Código [Seleccionar] Expandir




en un modulo:


Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task



en el formulario






Private f_Canal     As Integer     ' canal del fichero.

Private Sub List1_Click()
    Call BuscarItems(lisFechas.List(lisFechas.ListIndex))
End Sub

' Qué buscamos?: El dato (fecha), que se ha pulsado en list1...
'  y lo buscamos en todos los registros del fichero.
Private Sub BuscarItems(ByVal strFecha As String)
    Dim item As String

    List2.Clear
    Open App.Path & "\database.txt" For Random As f_canal Len = Len(file)

    Seek (f_Canal), 1     ' posicionar el puntero de lectura al comienzo del fichero (en vb6 es la dirección 1).
    Do While Not EOF(f_Canal)
        Get f_Canal, , file
        With file
            If (StrComp(strFecha, CStr(.Date), vbTextCompare) = 0) Then
                item = FormatStr(CStr(.Id), 6, True)
                item = FormatStr(item, 12) & _
                       FormatStr(CStr(.Date), 16) & _
                       FormatStr(.Name, 44)
                Call List2.AddItem(item)  ' list2, probablemente no precise estar ordenado...
            End If
        End With
    Loop

Close #f_canal
End Sub








gracias

hola soy corlo
tengo un pequeño problema a la hora de pasar informacion de un archivo de texto de list1, y que vaya leyendo cada dia en list2.
en list1 hay lo siguiente:
list1
11/12/2018
12/12/2018
13/12/2018
en el list2 hay losiguiente:

en el dia 11/12/2018

1       11/12/2018                a
1       11/12/2018                b
1       11/12/2018                c
4       11/12/2018                d
5       11/12/2018                e

en dia 12/12/2018

5       12/12/2018                f
7       12/12/2018                g
8       12/12/2018                h
9       12/12/2018                i

en dia 13/12/2018

10      13/12/2018               o
11      13/12/2018               p
12      13/12/2018               s

Código [Seleccionar] Expandir



Option Explicit
Dim n As Integer
Dim c As Integer


Private Sub Command1_Click()
Unload Me
Form1.Show
End Sub


Private Sub Form_Load()
List1.Clear
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)
n = LOF(1) / Len(file)
c = 1
For c = 1 To n


Get #1, , file

List1.AddItem file.date
QuitaDup
Next
Close #1
End Sub
Private Sub QuitaDup()
  Dim i As Long, X As Long
  X = List1.ListCount - 1
  For i = 0 To List1.ListCount - 2
    If List1.List(i) = List1.List(X) Then
     
      List1.RemoveItem X
     
      Exit For
    End If
  Next i
End Sub

Private Sub List1_Click()
Dim i As Integer
Dim ind As Integer
List2.Clear
Form1.Text1.Text = file.id
Form1.Text2.Text = file.date
Form1.Text3.Text = file.name
ind = List1.ListIndex
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)
n = LOF(1) / Len(file)
For i = 0 To List1.ListCount + 1
If ind <= 0 Then
Get #1, i + 1, file

List2.AddItem file.id & "         " & file.date & "          " & file.name
End If
Next
Close #1
End Sub






y en list2 solamente me lee el primer dia
que la rutina es en list1_click
y quisiera que me lea el primer dia el segundo dia y el tercer dia.
gracias.

Hola soy Corlo

hola quisiera pasar el codigo archivo secuencial de texto a archivo for random aleatorio
el codigo que tengo es este

Código [Seleccionar] Expandir



Dim i As Integer
mes = Text8.Text
fecha = Text1.Text
nombre = Text2.Text
apellido = Text3.Text
producto = Text4.Text
cantidad = Text5.Text
precio = Text6.Text
total = Val(Text5.Text) * Val(Text6.Text)
Text7.Text = Val(Text5.Text) * Val(Text6.Text)
archivo = App.Path & "\ventas.txt"
Open archivo For Append As #1
Write #1, mes, fecha, nombre, apellido, producto, cantidad, precio, total
For i = 0 To List1.ListCount - 1

        Print #1, List1.List(i)
        Next i
Close #1




Gracias

Hola soy Corlo

Tengo una duda en sumar el datos.subtotal del list1

el codigo que tengo hasta ahora es:

Código [Seleccionar] Expandir




dim gh as string
gh = App.Path & "\facturas" & "\" & Prefix_Facturas & Text3.Text & ".TXT"
        Open gh For Random As #1 Len = Len(datos)
        Get #1, (List1.ListIndex + 1), datos
        Text7.Text = datos.producto
        Text8.Text = datos.precio
        Text9.Text = datos.existencias
        Text10.Text = datos.subtotal
        Close #1





gracias

Hola soy Corlo
Estoy intentando modificar los datos de la factura en el list1 en la opcion modificar datos, cuando guardo los datos de la factura lo ha bien, cuando leo la factura lo hace bien, cuando selecciono un elemento del list1 pasa a los text4, text5, text6, lo hace bien, pero cuando cambio los datos de los text4, text5, text6, no me guarda en archivo random los datos cambiados en Guardar_Factura porque tiene que estar guardados en el list1, no se que hago mal.
Si alquien me puede ayudar, gracias.

Código [Seleccionar] Expandir



'DEFININMOS LOS ELEMENTOS DE LA FACTURA
Private Type Type_Articulos_Factura
    codigo_articulo As String
    nombre_articulo As String
    precio_articulo As String
End Type

Private Type Type_Datos_Factura
    Codigo_Factura As String
    Nombre_Cliente_Factura As String
    Fecha_Factura As String
    Articulos_Factura() As Type_Articulos_Factura
End Type
Dim factura As Type_Datos_Factura

Private Type Type_Indices
    Codigo_Facturas As Integer
    Codigo_Albaranes As Integer
End Type

Dim detalle As Integer
Const Prefix_Facturas = "Fact"  'Asignamos un prefijo a las facturas para cuandos se guarden
Private Indices As Type_Indices

Private Sub Agregar_Articulo(nombre_articulo, codigo_articulo, precio_articulo)
List1.AddItem nombre_articulo & Space(14) & codigo_articulo & Space(27) & precio_articulo
    factura.Articulos_Factura(UBound(factura.Articulos_Factura)).codigo_articulo = codigo_articulo
    factura.Articulos_Factura(UBound(factura.Articulos_Factura)).nombre_articulo = nombre_articulo
    factura.Articulos_Factura(UBound(factura.Articulos_Factura)).precio_articulo = precio_articulo
     ReDim Preserve factura.Articulos_Factura(0 To UBound(factura.Articulos_Factura) + 1)
End Sub

Private Sub Crear_Factura(Codigo_Factura, Nombre_Cliente, Fecha_Factura)
    factura.Codigo_Factura = Codigo_Factura
    factura.Nombre_Cliente_Factura = Nombre_Cliente
    factura.Fecha_Factura = Fecha_Factura
    ReDim Preserve factura.Articulos_Factura(0 To 0)
End Sub


Private Sub Command1_Click()
'Nueva Factura
Text4.SetFocus
List1.Clear
    Indices.Codigo_Facturas = Indices.Codigo_Facturas + 1
    Label1.Caption = Indices.Codigo_Facturas
    'GUARDAMOS EL CODIGO DE LA NUEVA FACTURA
    Open App.Path & "\Indices.txt" For Binary As #1
    Put #1, , Indices
    Close #1
    Label4.Caption = "Factura:"
   Text1.Text = "Pedro"
   Text2.Text = Date
    Crear_Factura Indices.Codigo_Facturas, Text1.Text, Text2.Text

   
    'Iniciamos la nueva Factura
   
    Command5.Enabled = True
    Command6.Enabled = True
   
   
   
End Sub

Private Sub Command2_Click()
   End
   
End Sub


Private Sub GUARDAR_FACTURA()
factura.Nombre_Cliente_Factura = Text1.Text
factura.Fecha_Factura = Text2.Text


     Open App.Path & "\" & Prefix_Facturas & Indices.Codigo_Facturas & ".TXT" For Binary As #1
     Put #1, , factura
     Close #1
     
     
End Sub

Private Sub Command3_Click()
' modificar datos
If List1.ListIndex < 0 Then
MsgBox "Ningún elemento ha sido seleccionado", vbInformation
Exit Sub
End If



List1.AddItem Text4.Text & Space(14) & Text5.Text & Space(27) & Text6.Text
List1.RemoveItem List1.ListIndex


GUARDAR_FACTURA

Call Command7_Click


End Sub

Private Sub Command5_Click()
GUARDAR_FACTURA
End Sub

Private Sub Command6_Click()
' Agregar articulo al list1
  Agregar_Articulo Text4.Text, Text5.Text, Text6.Text
End Sub

Private Sub Command7_Click()
'leer los datos de la factura
Dim gh As String, lp As String

Text1.Text = ""
Text2.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
List1.Clear
On Error GoTo err:

If Len(Dir(gh)) <> 0 Then
gh = App.Path & "\" & Prefix_Facturas & Text3.Text & ".TXT"
    Open gh For Binary Access Read Lock Read As #1
   
     Get #1, , factura
   
     Close #1
     Label1.Caption = factura.Codigo_Factura
     Text1.Text = factura.Nombre_Cliente_Factura
     Text2.Text = factura.Fecha_Factura
   
     For total_articulos = 0 To UBound(factura.Articulos_Factura) - 1
     nombre_articulo = factura.Articulos_Factura(total_articulos).nombre_articulo
      codigo_articulo = factura.Articulos_Factura(total_articulos).codigo_articulo
       precio_articulo = factura.Articulos_Factura(total_articulos).precio_articulo
     List1.AddItem nombre_articulo & Space(12) & codigo_articulo & Space(31) & precio_articulo
     
     Next
     
     End If
     
     Exit Sub
err:
MsgBox "Factura no Existe", vbCritical, "ERROR"
Kill gh
End Sub

Private Sub Form_Load()
' leer el numero de la ultima factura
Open App.Path & "\Indices.txt" For Binary As #1
    Get #1, , Indices
    Close #1
Label1.Caption = Indices.Codigo_Facturas
Command1.Enabled = True
Command5.Enabled = True
End Sub

Private Sub List1_Click()
' leer los datos del list1 a text4.text, text5.text, text6.text
Dim gh As String
Dim total_articulos As Integer
If List1.ListIndex < 0 Then
MsgBox "Ningún elemento ha sido seleccionado", vbInformation
Exit Sub
End If


gh = App.Path & "\" & Prefix_Facturas & Text3.Text & ".TXT"
    Open gh For Binary Access Read Lock Read As #1
   
     Get #1, , factura
      For total_articulos = 0 To List1.ListIndex
   
     Text4.Text = factura.Articulos_Factura(total_articulos).nombre_articulo
     Text5.Text = factura.Articulos_Factura(total_articulos).codigo_articulo
     Text6.Text = factura.Articulos_Factura(total_articulos).precio_articulo
     Next

     Close #1

End Sub





Hola soy corlo

tengo un problema a la hora de consultar por fecha en archivo secuencial, me lee todo el fichero, solo tiene que leer por fecha.
Guardar los datos lo hace bien

Código [Seleccionar] Expandir



Este formulario es el de grabar datos lo hace perfecto.

Dim fecha As String
Dim nombre As String
Dim apellido As String
Dim producto As String
Dim cantidad As Integer
Dim precio As Integer
Dim total As Integer
Dim archivo As String

Private Sub Command1_Click()
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text2.SetFocus
End Sub

Private Sub Command2_Click()
Dim i As Integer
fecha = Text1.Text
nombre = Text2.Text
apellido = Text3.Text
producto = Text4.Text
cantidad = Text5.Text
precio = Text6.Text
total = Val(Text5.Text) * Val(Text6.Text)
Text7.Text = Val(Text5.Text) * Val(Text6.Text)
archivo = App.Path & "\ventas.txt"
Open archivo For Append As #1
Write #1, fecha, nombre, apellido, producto, cantidad, precio, total
For i = 0 To List1.ListCount - 1

        Print #1, List1.List(i)
        Next i
Close #1

End Sub



Este formulario es el de consula

Dim fe As String
Dim nom As String
Dim apel As String
Dim prod As String
Dim cant As Integer
Dim prec As Integer
Dim tot As Integer
Dim archivo As String
Private Sub Command1_Click()
Unload Me
Form1.Show
End Sub
Private Sub Command2_Click()
Text1.Text = ""
List1.Clear
Text1.SetFocus
End Sub


Private Sub Command3_Click()
List1.Clear
List2.Clear
Dim k As Integer
If Text1.Text = "" Then Exit Sub
fe = Format(Text1.Text, Date)
Text1.Text = fe
Text2.Text = nom
Text3.Text = apel
Text4.Text = prod
Text5.Text = cant
Text6.Text = prec
Text7.Text = tot
archivo = App.Path & "\ventas.txt"
Open archivo For Input As #1
If fe = Date Then
While Not EOF(1)
Input #1, fe, nom, apel, prod, cant, prec, tot
List1.AddItem fe & "        " & nom & "       " & apel & "      " & prod & "       " & cant & "      " & prec & "        " & tot

Wend
End If
Close #1

End Sub



Gracias