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:
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