Retroceso del cursor en un combobox

10/07/2006 - 00:19 por klomkbock | Informe spam
Hola de nuevo a todos, aqui vuelvo con otro problema, para no variar.

Tengo un combobox en cuyos eventos KeyDown y KeyUp he introducido un
codigo (sacado del foro y retocado un poco) que reconoce las pulsaciones
del teclado y las asigna a una variable(Pulsos) de tal forma que si se
pulsa una tecla (no todas, se establecen algunas excepciones), Pulsos = 1
y cada vez que se pulsa una tecla se añade una unidad a pulsos:
Pulsos=Pulsos + 1. La tecla de retroceso(vbKeyBack) resta 1 cada vez a
pulsos si este es mayor que cero. El proceso va bastante bien, y pulsos
sirve para definir el nº de caracteres de la izquierda del combobox, para
usarlo como criterio para filtrar los datos de una hoja, comparandolo con
los registros de una columna concreta y trasladando el contenido del rango
"A:D" de las filas que vayan coincidiendo segun se escribe, a un ListBox
de 4 columnas. Uff...

Todo va bastante bien, pero al pulsar el retroceso, aunque pulsos
disminuye y el filtro se readapta y hace, creo que bien, su trabajo, el
cursor no retrocede (ni el sombreado de seleccion), con lo que si
introduces otro caracter no lo asimila a la coincidencia que aparece en el
combobox, sino que lo inserta en medio de lo que haya en el combo y,
claro, normalmente ya no existe ninguna coincidencia que reflejar en el
listbox.

No se si me he explicado, pero creo que no soy capaz de aclararlo mucho
mas.

Los codigos/extractos son los siguientes:

Private Sub cmbCriterio_KeyDown(ByVal KeyCode As MSForms _
.ReturnInteger, ByVal Shift As Integer)
Application.ScreenUpdating = False
Select Case KeyCode
Case vbKeyReturn, vbKeyEscape
SendKeys "{Esc}"
Case 32 To 255
Pulsos = Pulsos + 1
End Select
Application.ScreenUpdating = True
End Sub

El codigo referido al retroceso (vbKeyBack) iba originalmente en otro Case
del procedimiento anterior, pero tras varias pruebas, y la verdad es que
ya no tengo muy claro porque, lo acabe cambiando a KeyBack, donde creo que
funciona mejor¿¿??:

Private Sub cmbCriterio_KeyUp(ByVal KeyCode As MSForms _
.ReturnInteger, ByVal Shift As Integer)
If Not Pulsos > 0 Then Exit Sub
If KeyCode = vbKeyBack Then
If Pulsos > 0 Then Pulsos = Pulsos - 1
End If
With cmbCriterio
.
End Sub

Bueno, espero que mas o menos me hayais entendido. Si me podeis echar una
mano de nuevo, os lo agradezco.

Un saludo y hasta pronto.
Ivan

Preguntas similare

Leer las respuestas

#11 klomkbock
14/07/2006 - 21:43 | Informe spam
Hola Hector Miguel, disculpame por este nuevo mensaje pero me gustaria
hacerte tres consultas mas que se me han ocurrido (por supuesto sin el mas
minimo compromiso)

Por un lado, ¿seria posible eliminar los problemas con los teclazos si se
rellena la lista y se despliega, dando la opcion a elegir un registro que
se usaria integro como patron, pero si se escribe algo se elimina la
opcion de autocompletar, a ser posible sin borrar la lista, y se pasa al
uso de left(pulsos) como patron, y, de nuevo a ser posible dando la opcion
de si se vuelve a desplegar la lista y a escoger otro registro este pase a
ser el patron?

No se si me he explicado, pero estoy seguro que mas o menos sabes por
donde voy. Supongo que se podria usar el evento al desplegar ¿dropdown se
llama? la lista o algo similar, aunque me temo que vuelvo a meterme en
camisa de once varas.

Por otro lado con el ultimo codigo, debo estar haciendo algo mal, porque
me da la impresion de que se va en el 1º o en el 2º exit sub(aunque he
probado a deshabilitarlos y me sigue ocurriendo lo mismo), pues no me da
error y se escribe normalmente en el combo, pero no ejecuta las acciones
que deberia .

Y de aqui viene la 3ª duda (que son dos):

1.-el 1er msgbox: exit sub => este uso de msgbox ¿es como metodo de excel?
y tiene alguna caracteristica especial?. Por lo que creia en este uso de
la funcion msgbox se saldria siempre irremisiblemente del procedimiento.
Por lo que debe haber gato encerrado(de hecho tan encerrado que ni
aparece) o mi ignorancia es aun mayor de lo que pensaba. (como metodo no
lo he usado nunca y echare un vistazo a ver si lo encuentro en cuanto
envie)

2.-el uso de => Pulsos + (Pulsos > 1) -> me podrias explicar como funciona
exactamente; no acabo de verlo.

Bueno hector Miguel, disculpa este nuevo abuso, y comprendo perfectamente
si ya estes en otras lides ayudando a quien le haga mas/realmente falta.
Pero por probar que no quede.

En cualquier caso muchas gracias por todo.

Un saludo y hasta pronto.
Ivan
Respuesta Responder a este mensaje
#12 Héctor Miguel
14/07/2006 - 22:55 | Informe spam
hola, Ivan !

1) [ya me 'temia'] sabia que buscarias la 'doble funcionalidad' del combo para aprovechar -tambien- el autcompletar
y estoy buscando la mejor alternativa posible :)) [solo dame un poquitin de mas tiempo] :D

2) con respecto de que la rutina 'se termina'... [perdon]... se me quedo de las pruebas la linea que 'rompe' el procedimiento...
la que comentas del msgbox... => ELIMINALA ;)
[de todos modos] un msgbox NO 'termina' un procedimiento... -simplemente- lo interrumpe para mostrar su notificacion ;)

3) con relacion a la instruccion que no acabas de ver su funcionamiento: -> Pulsos + (Pulsos > 1)
a) cuando ya se ha iniciando el conteo de los pulsos, se ha empezado tambien a llenar el combo [probablemente autocompletado]
b) [aun asi] la ultima tecla pulsada... NO ha 'pasado' al combo [porque el usuario no le ha cedido el enfoque]
c) [pero] como el conteo de los pulsos va en avance, es necesario 'omitir' el ultimo pulso del contenido del combo [autocompletado ?]
- lo 'logico' seria una expresion del tipo: Pulsos = Pulsos - 1
- la expresion: (Pulsos > 1) al evaluarla [vba] como 'verdadero' la asigna el valor -1, si falso le asigna el valor 0
- [en resumen] si es verdadero... se convierte en: -> Pulsos + (-1) si es falso... en: -> Pulsos + (0)

[espero no haberte 'hecho pelotas'] :D si cualquier duda... comentas ?
saludos,
hector.

__ la consulta original __
... seria posible eliminar los problemas con los teclazos
si se rellena la lista y se despliega dando la opcion a elegir un registro que se usaria integro como patron
pero si se escribe algo se elimina la opcion de autocompletar, a ser posible sin borrar la lista
y se pasa al uso de left (pulsos) como patron
y, de nuevo... dando la opcion de si se vuelve a desplegar la lista y a escoger otro registro este pase a ser el patron?
... con el ultimo codigo, debo estar haciendo algo mal, porque me da la impresion de que se va en el 1º o en el 2º exit sub ...
... 3ª duda (que son dos):
1.-el 1er msgbox: exit sub => este uso de msgbox es como metodo de excel? y tiene alguna caracteristica especial?.
Por lo que creia en este uso de la funcion msgbox se saldria siempre irremisiblemente del procedimiento...

2.-el uso de => Pulsos + (Pulsos > 1) -> me podrias explicar como funciona exactamente; no acabo de verlo.
Respuesta Responder a este mensaje
#13 klomkbock
15/07/2006 - 04:17 | Informe spam
Hola Hector Miguel.

Solamente reiterarte mi agradecimiento y mi opinion de que no creo que
exista una escuela mejor que este foro ni mejores maestros que sus
participes.

Un saludo y hasta pronto
Ivan

PD-> resulta fascinante la cantidad de posibles derivaciones que pueden surgir
de un solo dedo.
Respuesta Responder a este mensaje
#14 klomkbock
16/07/2006 - 00:29 | Informe spam
Hola de nuevo, Hector Miguel.

Lo primero una pequeña sesion de psicoanalisis: aparte de mi (parece que)
incurable obsesion por poner en multiples mensajes lo que, con un poco
menos de precipitacion y un poco mas de reflexion/observacion, podria
poner en uno solo, tambien tengo la agotadora(y te aseguro que por lo
general incosciente) tendencia a afrontar las cosas por el camino mas
complejo y/o retorcido, lo que suele llevarme a perder incontable tiempo(y
por desgracia, en ocasiones a hacerselo perder a los demas) y a desgastar
innecesariamente mi neurona(esto en esta ocasion no es del todo cierto,
pues los frutos de este hilo son cuantiosos).

Y despues de este bodrio, comentarte que creo haber resuelto mas o menos
la papeleta (a falta de mas pruebas), aunque quizas de una forma un tanto
chapucera. He puesto la propiedad de autocompletar del combo a falso y he
eliminado todo lo relacionado con los pulsos, limitando el patron a lo que
aparece en el combo.

A continuacion pongo los codigos relacionados con el proceso, en los
cuales hay muchas aplicaciones de otras de tus respuestas (aunque sigo con
la espina de los filtros avanzados fuertemente clavada).

Cualquier comentario, apunte o modificacion que te parezca pertinente,
sera bien recibido.

En los codigos intervienen un primer combo (con los titulos de campo), un
segundo combo (cmbCriterio) y un listbox que se rellena a partir de este
ultimo. No los decribo mas porque supongo que despues de este hilo, y
algunos anteriores, mas o menos sabes de lo que van, pero si crees
necesaria alguna aclaracion, por aqui ando.

==>>en el modulo del formulario->>

Option Explicit
Dim Patron As String
Dim nL As Byte, fF As Long, fFo As Long
Dim Lista
Dim msgNo As Boolean
Private Sub cmbCriterio_Change()
If msgNo = True Then Exit Sub
With cmbElegir
If .ListIndex = -1 Then
msgNo = True
With cmbCriterio: .Clear: .Text = "": End With
.ListIndex = -1: .SetFocus
MsgBox ("Tienes que elegir un campo para la busqueda.")
Exit Sub
Else
nL = .ListIndex
End If
End With
Patron = Trim(cmbCriterio)
With Worksheets("Oculta")
Call FiltrarHjAOtra(.Name, "Listado", nL + 1, Patron & "*")
fFo = .[a65536].End(xlUp).Row
Lista = .Range("a1:d" & fFo)
With lstSeleccionar: .Clear: .List = Lista
.ListIndex = -1: txtNroLibros = .ListCount: End With
End With
''sustituye al msgbox informativo. Luego se eliminaria=>
lblPulsos_Patron.Caption = "Patron = " & """" & Patron & """"
End Sub
Private Sub cmbElegir_Change()
Dim sig As Long
Dim Celda As Range
Dim regUnicos As New Collection
Application.ScreenUpdating = False
msgNo = False
With cmbCriterio: .Clear
With lstSeleccionar: .Clear: .ListIndex = -1: End With
Patron = ""
With cmbElegir
If .ListIndex > -1 Then
nL = .ListIndex
Else
Exit Sub
End If
End With
With Worksheets("Listado")
fF = .[a65536].End(xlUp).Row
.Range(.Range("a1"), .Range("z" & fF)).Sort _
key1:=.Range("a1")(1, nL + 1), header:=xlYes
On Error Resume Next
For Each Celda In .Range(.Cells(2, nL + 1), .Cells(fF, nL + 1))
If Trim(Celda) <> "" Then regUnicos.Add Celda, CStr(Celda)
Next
On Error GoTo 0
End With
For sig = 1 To regUnicos.Count
.AddItem regUnicos.Item(sig)
Next
.ListIndex = -1
End With
Set regUnicos = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
Dim nC As Byte
With cmbElegir
For nC = 1 To 26
.AddItem Worksheets("Listado").Range("a1")(1, nC).Value
Next
.SetFocus
End With
optBuscar = True
msgNo = False
End Sub

NOTA: la variable msgNo es para evitar que el msgbox aparezca dos veces en
el change de cmbCriterio (he probado a desactivar eventos y otras cuantas
cosas, pero no he podido evitar que saliera dos veces mas que de esta
forma)

==>>en un modulo normal>>

Public Function FiltrarHjAOtra(ByVal HjDestino As String, _
ByVal HjOrigen As String, ByVal colFiltro As Byte, _
ByVal CriterioF As String)
''la hoja origen tiene los titulos en la fila 1 _
'''la de destino no tiene titulos y los datos se copian _
'''a partir de la fila 1 incluida
Worksheets(HjDestino).UsedRange.EntireRow.Delete
With Worksheets(HjOrigen)
.UsedRange.AutoFilter
If .AutoFilterMode Then
.Range("a1").CurrentRegion.AutoFilter _
Field:=colFiltro, _
Criteria1:=CriterioF
With .AutoFilter.Range
If .Rows.Count > 1 Then
On Error Resume Next
.Resize(.Rows.Count - 1).Offset(1) _
.SpecialCells(xlCellTypeVisible) _
.Copy Worksheets(HjDestino).Range("a1")
On Error GoTo 0
End If
End With
End If
.AutoFilterMode = False
End With
End Function

En cualquier caso muchas gracias de nuevo por todo.

Un saludo y hasta pronto
Ivan

PD: a ver si me entra en la cabeza: "seguramente el camino mas evidente
suele ser el mas corto".
Respuesta Responder a este mensaje
#15 Héctor Miguel
16/07/2006 - 05:37 | Informe spam
hola, Ivan !

... creo haber resuelto mas o menos la papeleta (a falta de mas pruebas)... los codigos relacionados con el proceso
... (aunque sigo con la espina de los filtros avanzados fuertemente clavada).
... comentario, apunte o modificacion... sera bien recibido.
... primer combo (con los titulos de campo)... segundo combo (cmbCriterio) y un listbox que se rellena a partir de este ultimo...
NOTA: la variable msgNo es para evitar que el msgbox aparezca dos veces en el change de cmbCriterio
(he probado a desactivar eventos y otras cuantas cosas, pero no he podido evitar que saliera dos veces mas que de esta forma)



tus pruebas 'van mas rapido'... que mi tiempo :)) asi que... [en esta ocasion] solo me atrevo a sugerirte [peque#as] modificaciones...

1) supongo que el 'doble-disparo' del msgbox se debe a que [por otros codigos] 'limpias' al combo [que es un '_change'] -?-
2) supongo que habra 'miles' de registros [aun filtrando] y en esos casos, un objeto 'Collection' NO es 'lo mas rapido' para llenar controles :-(
3) estoy oitiendo [segun yo] la necesidad de las variables msgNo y Lista y el 'tener que' sumar 1 a la variable nL [en llamadas posteriores] ;)
solo asegurate que el cmbCriterio sea el primero en el orden de tabulacion de los objetos en el formuario ;)
4) prueba las siguientes adaptaciones [que solo son un 'recorte' a las lineas de codigo] en los eventos '_initialize' y 'cmbCriterio_Change'
5) supongo que no 'escaparas' de buscar la manera de 'sacarte la espina'... de los filtros avanzados :D

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

Private Sub UserForm_Initialize()
cmbElegir.List = Worksheets("Listado").Range("a1:z1").Value
End Sub

Private Sub cmbCriterio_Change()
With cmbElegir
If .ListCount < 1 Then Exit Sub Else nL = .ListIndex + 1
If nL < 1 Then MsgBox "Tienes que elegir un campo para la busqueda.": _
.SetFocus: cmbCriterio.Clear: Exit Sub
End With
Patron = Trim(cmbCriterio)
With Worksheets("Oculta")
Call FiltrarHjAOtra(.Name, "Listado", nL, Patron & "*")
fFo = .[a65536].End(xlUp).Row
lstSeleccionar.Clear
lstSeleccionar.List = .Range("a1:d" & fFo).Value
txtNroLibros = fFo
End With
lblPulsos_Patron.Caption = "Patron = " & """" & Patron & """"
End Sub

__ los codigos expuestos __
==>>en el modulo del formulario->>
Option Explicit
Dim Patron As String
Dim nL As Byte, fF As Long, fFo As Long
Dim Lista
Dim msgNo As Boolean

Private Sub cmbCriterio_Change()
If msgNo = True Then Exit Sub
With cmbElegir
If .ListIndex = -1 Then
msgNo = True
With cmbCriterio: .Clear: .Text = "": End With
.ListIndex = -1: .SetFocus
MsgBox ("Tienes que elegir un campo para la busqueda.")
Exit Sub
Else
nL = .ListIndex
End If
End With
Patron = Trim(cmbCriterio)
With Worksheets("Oculta")
Call FiltrarHjAOtra(.Name, "Listado", nL + 1, Patron & "*")
fFo = .[a65536].End(xlUp).Row
Lista = .Range("a1:d" & fFo)
With lstSeleccionar: .Clear: .List = Lista
.ListIndex = -1: txtNroLibros = .ListCount: End With
End With
''sustituye al msgbox informativo. Luego se eliminaria=>
lblPulsos_Patron.Caption = "Patron = " & """" & Patron & """"
End Sub

Private Sub cmbElegir_Change()
Dim sig As Long
Dim Celda As Range
Dim regUnicos As New Collection
Application.ScreenUpdating = False
msgNo = False
With cmbCriterio: .Clear
With lstSeleccionar: .Clear: .ListIndex = -1: End With
Patron = ""
With cmbElegir
If .ListIndex > -1 Then
nL = .ListIndex
Else
Exit Sub
End If
End With
With Worksheets("Listado")
fF = .[a65536].End(xlUp).Row
.Range(.Range("a1"), .Range("z" & fF)).Sort _
key1:=.Range("a1")(1, nL + 1), header:=xlYes
On Error Resume Next
For Each Celda In .Range(.Cells(2, nL + 1), .Cells(fF, nL + 1))
If Trim(Celda) <> "" Then regUnicos.Add Celda, CStr(Celda)
Next
On Error GoTo 0
End With
For sig = 1 To regUnicos.Count
.AddItem regUnicos.Item(sig)
Next
.ListIndex = -1
End With
Set regUnicos = Nothing
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
Dim nC As Byte
With cmbElegir
For nC = 1 To 26
.AddItem Worksheets("Listado").Range("a1")(1, nC).Value
Next
.SetFocus
End With
optBuscar = True
msgNo = False
End Sub

==>>en un modulo normal>>
Public Function FiltrarHjAOtra(ByVal HjDestino As String, _
ByVal HjOrigen As String, ByVal colFiltro As Byte, _
ByVal CriterioF As String)
''la hoja origen tiene los titulos en la fila 1 _
'''la de destino no tiene titulos y los datos se copian _
'''a partir de la fila 1 incluida
Worksheets(HjDestino).UsedRange.EntireRow.Delete
With Worksheets(HjOrigen)
.UsedRange.AutoFilter
If .AutoFilterMode Then
.Range("a1").CurrentRegion.AutoFilter _
Field:=colFiltro, _
Criteria1:=CriterioF
With .AutoFilter.Range
If .Rows.Count > 1 Then
On Error Resume Next
.Resize(.Rows.Count - 1).Offset(1) _
.SpecialCells(xlCellTypeVisible) _
.Copy Worksheets(HjDestino).Range("a1")
On Error GoTo 0
End If
End With
End If
.AutoFilterMode = False
End With
End Function

PD: a ver si me entra en la cabeza: "seguramente el camino mas evidente suele ser el mas corto".
Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaSiguiente AnteriorRespuesta Tengo una respuesta
Search Busqueda sugerida