InputBox al que se le incluye un ComboBox
He leído en muchas webs que la funcion InputBox permite unicamente la entrada de texto simple, lo que sugieren es crear un formulario en el que poner el combobox y eso he hecho, mi problema viene al volcar el contenido del combobox en una celda específica.
Pongo el código por si me podéis sugerir algo
Private Sub aprobado_click()
Dim estado, prioridad As String
estado = ComboBox1.Value
prioridad = ComboBox2.Value
Set h = Sheets("SELECCIÓN")
Set r = h.Columns("W")
Set b = r.Find(estado, lookat:=xlWhole)
If ComboBox1 = "" Or ComboBox2 = "" Then
alerta = MsgBox("Debes seleccionar los criterios de búsqueda", vbalert, "RRHH")
If alerta = vbOK Then Exit Sub
End If
If Not b Is Nothing Then
ncell = b.Address
Do
If h.Cells(b.Row, "Q") = prioridad Then
alerta = MsgBox("Vas a proceder a APROBAR la solicitud " & h.Cells(b.Row, "A").Value, vbalert, "RRHH")
If alerta = vbOK Then
h.Cells(b.Row, "W").Value = "APROBADO"
h.Cells(b.Row, "X").Value = Now
h.Cells(b.Row, "Y").Formula = Year(h.Cells(b.Row, "X").Value)
h.Cells(b.Row, "Z").Formula = MonthName(Month(h.Cells(b.Row, "X").Value), False)
h.Cells(b.Row, "AA").Formula = Day(h.Cells(b.Row, "X").Value)
frmpersonalseleccion.Show
aprobado.Visible = False
denegado.Visible = True
pausado.Visible = True
buscar.Visible = False
End If
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End Sub
Quiero que el valor del combobox1 del frmpersonalseleccion se ponga en la h.Cells(b.Row, "AB") de este proceso.
Pongo la programacion que tengo en el frmpersonalseleccion
Private Sub CommandButton1_Click()
'aquí debería ir un código
Unload Me
End Sub
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
ComboBox1.Clear
Sheets("ESCALAS").Select
Range("E1").Select
Do While ActiveCell.Value <> ""
ComboBox1.AddItem ActiveCell
ActiveCell.Offset(1, 0).Select
Loop
End Sub
1 respuesta
Algo no estoy entendiendo, si ya estás ejecutando tu userform, ya no es necesaria esta línea:
frmpersonalseleccion.Show
Agrega después de esta línea:
h.Cells(b.Row, "AA").Formula = Day(h.Cells(b.Row, "X").Value)
Esta línea:
h.Cells(b.Row, "AB").value = ComboBox1.Value
Si no es así, entonces envíame tu archivo para ver cómo estás ejecutando el userform.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Gabriel Méndez” y el título de esta pregunta.
Avísame en esta pregunta cuando me lo hayas enviado.
Si lo anterior resuelve tu duda
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
El formulario frmpersonalseleccion abre otro formulario dado que estoy en frmaprobaciones.
Te he enviado el archivo para que lo entiendas mejor ya que en mi cabeza yo lo tengo claro, pero explicarlo es un poco más difícil
Te anexo el código para un nuevo formulario
Dim h1, h2, h3
'
Private Sub ComboBox1_Change()
Call Filtrar
End Sub
Private Sub ComboBox2_Change()
Call Filtrar
End Sub
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
If ListBox1.ListIndex = -1 Or ComboBox1 = "" Or ComboBox1.ListIndex = -1 Then
MsgBox "Selecciona un registro y un técnico"
Exit Sub
End If
'
fila = ListBox1.List(ListBox1.ListIndex, ListBox1.ColumnCount - 1)
h1.Cells(fila, "W") = "APROBADO"
h1.Cells(fila, "X") = Now
h1.Cells(fila, "AB") = ComboBox3
Call Filtrar
MsgBox "Registro Actualizado"
End Sub
'
Sub Filtrar()
'Por.Dante Amor
ListBox1.RowSource = ""
h3.Cells.Clear
h1.Rows(1).Copy h3.Rows(1)
If ComboBox1 = "" Or ComboBox2 = "" Then Exit Sub
'
Application.ScreenUpdating = False
j = 2
uc = h1.Cells(1, Columns.Count).End(xlToLeft).Column + 1
'
Set r = h1.Columns("W")
Set b = r.Find(ComboBox1, LookAt:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If h1.Cells(b.Row, "Q") = ComboBox2 Then
h1.Rows(b.Row).Copy h3.Rows(j)
h3.Cells(j, uc) = b.Row
j = j + 1
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
'
uc = h1.Cells(1, Columns.Count).End(xlToLeft).Column + 1
rango = h1.Range(h1.Cells(2, "A"), h1.Cells(j, uc)).Address
ListBox1.RowSource = h3.Name & "!" & rango
Application.ScreenUpdating = True
End Sub
'
'Private Sub ListBox1_Click()
' Label20.Caption = ListBox1.List(ListBox1.ListIndex, 27)
'End Sub
'
Private Sub UserForm_Activate()
'Por.Dante Amor
Set h1 = Sheets("SELECCIÓN")
Set h2 = Sheets("ESCALAS")
Set h3 = Sheets("TEMP")
'
For i = 1 To h2.Range("N" & Rows.Count).End(xlUp).Row
ComboBox1.AddItem h2.Cells(i, "N")
Next
For i = 1 To h2.Range("Q" & Rows.Count).End(xlUp).Row
ComboBox2.AddItem h2.Cells(i, "Q")
Next
For i = 1 To h2.Range("E" & Rows.Count).End(xlUp).Row
ComboBox3.AddItem h2.Cells(i, "E")
Next
'
uc = h1.Cells(1, Columns.Count).End(xlToLeft).Column + 1
ListBox1.ColumnCount = uc
End Subsal u dos
