Ayuda con Text List
Publicado por Darufu (1 intervención) el 21/01/2019 21:25:18
Hola buen dia:
tengo una base de datos que se va llenando con un formulario basicamente son items que se ingresan se reparan y salen, entonces todo bien pero cuando quiero ingresar la salida del equipo tengo un listbox que se alimenta de las base de datos y mediante un text box ingreso el numero de serie lo busca y me lo muestra en dicha lista pero el problema esta aqui, ya que cuando lo lo selecciono en el listbox quiero que tambien se seleccione en la base de datos y en base a eso me capture la fecha de salida del item (now) y quede registrado en X celda denominada fechay un par de datos mas agrego el codigo que estoy utilizando para el Uform de salidas.
de antemano muchas gracias por la ayuda.
este es del Uform principal:
Y ESTE ES EL DEL UFORM DE SALIDA
tengo una base de datos que se va llenando con un formulario basicamente son items que se ingresan se reparan y salen, entonces todo bien pero cuando quiero ingresar la salida del equipo tengo un listbox que se alimenta de las base de datos y mediante un text box ingreso el numero de serie lo busca y me lo muestra en dicha lista pero el problema esta aqui, ya que cuando lo lo selecciono en el listbox quiero que tambien se seleccione en la base de datos y en base a eso me capture la fecha de salida del item (now) y quede registrado en X celda denominada fechay un par de datos mas agrego el codigo que estoy utilizando para el Uform de salidas.
de antemano muchas gracias por la ayuda.
este es del Uform principal:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
Private Sub DatosUF_Initialize()
End Sub
Private Sub cmdCerrar_Click()
Unload Me
End Sub
Private Sub CheckBoxGarantia_Click()
If CheckBoxGarantia Then
ComboReparador.Enabled = True
Else
ComboReparador.Enabled = False
End If
End Sub
Private Sub cmdGuardar_Click()
ActiveSheet.Unprotect ""
'Busqueda de valores duplicados
Dim UltFil As Long
UltFil = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If Application.WorksheetFunction.CountIf(ActiveSheet.Range("A1:A" & UltFil), Me.Textserial) >= 3 Then
MsgBox "Esta Unidad cuenta con mas de 3 Reparaciones", 64, ""
'Limpia el formulario
Me.Textserial.Value = “”
Me.Textmodelo.Value = “”
Me.Textproyecto = “”
Me.Combodefecto.Value = “”
Me.Textubicacion.Value = “”
Me.Combodificultad.Value = “”
Me.Comboorigen.Value = “”
Me.Textserial.SetFocus
Exit Sub
End If
Range("a1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
'definimos las variables
Dim iFila As Long
Dim ws As Worksheet
Set ws = Worksheets(1)
'Encuentra la siguiente fila vacía
iFila = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'Copia los datos a la tabla Excel
Dim FechaActual As Date
FechaActual = DateValue(Now)
ws.Cells(iFila, 1).Value = Me.Textserial.Value
ws.Cells(iFila, 2).Value = Me.Textmodelo.Value
ws.Cells(iFila, 3).Value = Me.Textproyecto.Value
ws.Cells(iFila, 6).Value = Me.Combodefecto.Value
ws.Cells(iFila, 7).Value = Me.Textubicacion.Value
ws.Cells(iFila, 10).Value = Me.Comboorigen.Value
ws.Cells(iFila, 12).Value = Me.Combodificultad.Value
ws.Cells(iFila, 4).Value = DateValue(Now)
'Captura si es garantia
If CheckBoxGarantia.Value = True Then ws.Cells(iFila, 15).Value = 1
If CheckBoxGarantia.Value = False Then ws.Cells(iFila, 15).Value = 0
If CheckBoxGarantia.Value = True Then ws.Cells(iFila, 16).Value = Me.ComboReparador.Value
'Limpia el formulario
Me.Textserial.Value = “”
Me.Textmodelo.Value = “”
Me.Textproyecto = “”
Me.Combodefecto.Value = “”
Me.Textubicacion.Value = “”
Me.Combodificultad.Value = “”
Me.Comboorigen.Value = “”
Me.ComboReparador.Value = “”
Me.CheckBoxGarantia.Value = False
Me.Textserial.SetFocus
ActiveWorkbook.SaveActiveSheet.Protect ""
'Para Actualizar Tablas
Dim xWs As Worksheet
Dim xTable As PivotTable
For Each xWs In Application.ActiveWorkbook.Worksheets
For Each xTable In xWs.PivotTables xTable.RefreshTableNext
Next
End Sub
Private Sub Combodefecto_Change()
End Sub
Private Sub Combodificultad_Change()
End Sub
Private Sub Comboorigen_Change()
End Sub
Private Sub CommandButton1_Click()
ActiveSheet.Unprotect ""
'Boton para Dar Salidas
Sheets("Inicio").Select Range("A1").Select
If ActiveCell.CurrentRegion.Columns.Count <= 1 Then
MsgBox "No hay datos para cargar.", vbExclamation, "EXCELeINFO"
Else
frmBuscar2.ShowEnd If
End Sub
Private Sub Label12_Click()
End Sub
Private Sub Textproyecto_Change()
End Sub
Private Sub UserForm_Activate()
End Sub
Y ESTE ES EL DEL UFORM DE SALIDA
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
'Cambia el TextBox con cada cambio en el Combo
'
Private Sub cmbEncabezado_Change()
Me.lblFiltro = "Filtro por " & Me.cmbEncabezado.Value
End Sub
'
'Cerrar formulario
Private Sub CommandButton2_Click()
Unload Me
ActiveSheet.Protect ""
End Sub
'
'
'Mostrar resultado en ListBox
Private Sub CommandButton5_Click()
On Error GoTo Errores
If Me.txtFiltro1.Value = "" Then Exit Sub
Me.ListBox1.Clear
Columna = Me.cmbEncabezado.ListIndex
j = 1Filas = Range("a1").CurrentRegion.Rows.Count
For i = 2 To FilasIf LCase(Cells(i, j).Offset(0, CInt(Columna)).Value) Like "*" & LCase(Me.txtFiltro1.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, j)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, j).Offset(0, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Cells(i, j).Offset(0, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Cells(i, j).Offset(0, 3)
Else
End If
Next i
Exit Sub
Errores:MsgBox "No se encuentra.", vbExclamation, "EXCELeINFO"
End Sub
'
'Activar la celda del registro elegido
Private Sub ListBox1_Click()
Range("a1").Activate
Cuenta = Me.ListBox1.ListCount
Set rango = Range("A1").CurrentRegion
For i = 1 To Cuenta - 1
If Me.ListBox1.Selected(i) Then
Valor = Me.ListBox1.List(i)
rango.Find(What:=Valor, LookAt:=xlWhole, After:=ActiveCell).Activate
End If
Next i
End Sub
'
'Dar formato al ListBox y traer los encabezados de la tabla
Private Sub UserForm_Initialize()
'
For i = 1 To 4Me.Controls("Label" & i) = Cells(1, i).Value
Next i
'
With Me
.ListBox1.ColumnCount = 4
.ListBox1.ColumnWidths = "60 pt;60 pt;60 pt;60 pt"
.cmbEncabezado.List = Application.Transpose(ActiveCell.CurrentRegion.Resize(1).Value)
.cmbEncabezado.ListStyle = fmListStyleOption
End With
End Sub
Valora esta pregunta
0