BuscarV Multiples Opciones

hola, Oscar !

> ... me he tropezado con una "Pared" ... se me esfumaron el ComboBox1 y

> Se que me ganare un "Jalon de orejas" si no entendi.

'pues'... una parte porque no 'entendiste' y 'otra'... porque no

=> el combobox + el listbox + el codigo... 'van' =>todos<= en el modulo de

=> los datos 'a listar'... 'se leen' de la hoja con los articulos y sus

=> el codigo lo he 'adaptado' debido a que tienes celdas 'combinadas' [en

=> los siguientes son los 'cambios' [que 'tienes que' hacer] ;)
1.- estando en 'modo de diseño' [barra de herramientas 'cuadro de

'corta' el combobox y el listbox [de la hoja de los articulos] y...
'pegalos' =>en la hoja con el formato de la factura<= [no te

2.- en el editor de vba, en la ventana de las propiedades, =>modificales<las siguientes:
ComboBox1:
- Height -> 18
- SelectionMargin -> False
- Width -> 73.5
ListBox1:
- ColumnCount -> 3
- ColumnWidths -> 256;87;65
- Height -> 63
- Width -> 424.5
3.- 'regresa' a la hoja de calculo [no mas en vba] y 'termina' el modo de

4.- 'pega' las lineas de codigo 'adaptadas' =>en el modulo de codigo de la

¿comentas?
saludos,
hector.
- el codigo para el modulo de la hoja de la factura es.
Private Sub Worksheet_Activate(): ActualizarCombo: End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("b20:b39")) Is Nothing Then
With Me.ComboBox1
If Target <> "" Then .Text = Target Else .ListIndex = 0
.Left = Target.Left: .Top = Target.Top - 1: .Visible = True
End With
Else: Me.ComboBox1.Visible = False
End If
If Intersect(Target, Range("d20:g39")) Is Nothing Then
Me.ListBox1.Visible = False: Exit Sub
End If
With Me.ListBox1
If Target.Offset(, -2) <> "" Then
Call ActualizarLista: .Left = Target.Left: .Top = Target.Top:

Else: .Visible = False
End If: End With
End Sub
Private Sub ActualizarCombo(): Dim Celda As Range, Elementos As New

Me.ComboBox1.Clear: Me.ComboBox1.AddItem "Seleccionar..."
With Worksheets("ARTICULOS")
For Each Celda In .Range(.Range("a2"), .Range("a65536").End(xlUp))
On Error Resume Next: Elementos.Add Celda, CStr(Celda)
Next: End With
With Me.ComboBox1
For Sig = 1 To Elementos.Count: .AddItem Elementos.Item(Sig)
Next: .AddItem "Borrar": .ListIndex = 0: End With
End Sub
Private Sub ComboBox1_Change(): If Intersect(ActiveCell, Range("b20:b39"))

With Me.ComboBox1
If .ListIndex > 0 Then
If .ListIndex = .ListCount - 1 Then
Range(ActiveCell, ActiveCell.Offset(, 7)).ClearContents:

ElseIf .Text <> ActiveCell Then
ActiveCell = .Text: Range(ActiveCell.Offset(, 1),

End If
ElseIf .ListIndex = 0 And ActiveCell <> "" Then
.Text = ActiveCell
End If: End With: SendKeys "{Esc}"
End Sub
Private Sub ActualizarLista(): Dim Celda As Range, Sig As Integer:

With Worksheets("ARTICULOS")
For Each Celda In .Range(.Range("a2"), .Range("a65536").End(xlUp))
If LCase(Celda) = LCase(ActiveCell.Offset(, -2)) Then
With Me.ListBox1: .AddItem
.List(Sig, 0) = Celda.Offset(, 1)
.List(Sig, 1) = Celda.Offset(, 2): .List(Sig, 2) Celda.Offset(, 3): Sig = Sig + 1
End With: End If: Next: End With
End Sub
Private Sub ListBox1_Click()
With Me.ListBox1
ActiveCell = .List(.ListIndex, 0)
ActiveCell.Offset(, 1) = .List(.ListIndex, 1): ActiveCell.Offset(, 2)

End With: SendKeys "{Esc}"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range): Dim Fila As Integer
If Intersect(Target, Range("b20:b39,c20:c39")) Is Nothing Then Exit Sub
For Fila = 20 To 39
If Cells(Fila, 3) > 0 And Cells(Fila, 9) > 0 Then
Cells(Fila, 10) = Cells(Fila, 3) * Cells(Fila, 9)
Cells(Fila, 1) = Application.Count(Range(Cells(20, 9), Cells(Fila,

End If
If Not IsEmpty(Cells(Fila, 2)) _
Then Cells(Fila, 1) = Application.CountA(Range(Cells(20, 2),

Else Cells(Fila, 1).ClearContents
If IsEmpty(Cells(Fila, 3)) Or IsEmpty(Cells(Fila, 9)) Then Cells(Fila,

Next
End Sub

... funciona [...]

... hay que ser muy cuidadoso en cada paso porque un click fuera de secuencia
... mensaje "Se ha producido un error "380" en tiempo de ejecucion".

De todas formas, me siento muy bien servido.