Error con UserForm
Hola. Quiero realizar una macro en Excel, en la cual a través de un botón que se encuentra en la propia Excel, en la hoja1 ("Hoja Selección") llamado "Piezas", me surja un UserForm ("UserForm1") el cual contiene un ComboBox ("ComboBox1"), un ListBox ("ListBox1"), un TextBox ("TextBox1") y un botón de comando ("Aceptar").
Lo que quiero es que al pinchar en el combo me surja una lista de piezas recogida de la Fila 1 de la hoja2 ("Elementos actualizados"), escoger una y que aparezca en el ListBox en dos columnas, las cotas en una columna y sus valores en la otra columna, los cuales los recoge también de la hoja2 ("Elementos actualizados"), que se encuentran justo debajo de la pieza escogida en el combo, son dos columnas, una para las cotas y otra para sus valores.
A su vez pinchamos en una de las cotas del ListBox y esta cota aparecerá en el TextBox, esta cota del TextBox la podremos modificar y al dar Enter nos pasará esa cota al Excel a la celda correspondiente y a su vez el ListBox se actualizará.
Si queremos cambiar otra cota u otra pieza se volvería a hacer las mismas operaciones.
Este es el código que he ido recogiendo de Internet, el problema es que la aplicación a veces funciona bien por completo y otras veces se cuelga.
El botón que se encuentra en Excel en la hoja1 ("Hoja Selección"), su código está contenido en el código interno de la hoja1.
La hoja2 ("Elementos actualizados") es más o menos así:
Eje | Codo | Tubo |
D | 20 | H | 40 | D | 30 |
L | 300 | R | 30 | L | 150 |
-----------------------------------------
Private Sub Piezas_Click()
UserForm1.Show
End Sub
-------------------------------------------
A partir de aquí el código se encuentra dentro del propio libro de VBA en el UserForm
Private Sub UserForm_Initialize()
Sheets("Elementos actualizados").Select
'Seleccionamos la celda A1
Range("A1").Select
'Hasta que no encuentre una columna vacía
'que llene todo con datos
Do While ActiveCell <> Empty
ComboBox1.AddItem ActiveCell.value
'nos desplazamos una columna a la derecha
ActiveCell.Offset(0, 1).Select
Loop
End Sub
--------------------------------
Private Sub ComboBox1_Change()
ListBox1.Clear
Dim rngRango As Range
columna = (2 * ComboBox1.ListIndex + 1)
Sheets("Elementos actualizados").Select
Cells(2, columna).Select
Do While ActiveCell <> Empty
'nos desplazamos una columna a la derecha
ActiveCell.Offset(1, 0).Select
Loop
filaUlt = ActiveCell.Row
Set rngRango = Worksheets("Elementos actualizados").Range(Cells(2, columna), Cells(filaUlt, columna + 1))
Me.ListBox1.ColumnCount = rngRango.Columns.Count
Me.ListBox1.RowSource = rngRango.Address(external:=True)
Set rngRango = Nothing
End Sub
-------------------------------------------------
Private Sub ListBox1_Click()
columna = (2 * ComboBox1.ListIndex + 1)
fila = ListBox1.ListIndex + 2
Cells(fila, columna + 1).Select
TextBox1.value = ActiveCell.value
End Sub
-------------------------------------------------
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
columna = (2 * ComboBox1.ListIndex + 1)
fila = ListBox1.ListIndex + 2
If KeyCode = vbKeyReturn Then
Cells(fila, columna + 1) = TextBox1
End If
End Sub
Private Sub Aceptar_Click()
Unload UserForm1
End Sub
------------------------------------------
Cuando lo ejecuto paso a paso se ejecuta perfectamente hasta que llego al TextBox y le doy al Enter entonces se ejecuta el TextBox1_KeyDown hasta
If KeyCode = vbKeyReturn Then
Cells(fila, columna + 1) = TextBox1
Y de repente se vuelve a ejecutar el ListBox1_Click, este se ejecuta 2 veces, y vuelve a terminar al TextBox. Si hay suerte se ejecuta sin problemas sino puede que se cuelge en TextBox1_KeyDown en Cells(fila, columna + 1) = TextBox1 o en End Sub.
El error que me muestra es un error de en tiempo de ejecución y me lo situa en el botón:
Private Sub Piezas_Click()
UserForm1.Show
End Sub
Muchas gracias y perdona por la parrafada.
Lo que quiero es que al pinchar en el combo me surja una lista de piezas recogida de la Fila 1 de la hoja2 ("Elementos actualizados"), escoger una y que aparezca en el ListBox en dos columnas, las cotas en una columna y sus valores en la otra columna, los cuales los recoge también de la hoja2 ("Elementos actualizados"), que se encuentran justo debajo de la pieza escogida en el combo, son dos columnas, una para las cotas y otra para sus valores.
A su vez pinchamos en una de las cotas del ListBox y esta cota aparecerá en el TextBox, esta cota del TextBox la podremos modificar y al dar Enter nos pasará esa cota al Excel a la celda correspondiente y a su vez el ListBox se actualizará.
Si queremos cambiar otra cota u otra pieza se volvería a hacer las mismas operaciones.
Este es el código que he ido recogiendo de Internet, el problema es que la aplicación a veces funciona bien por completo y otras veces se cuelga.
El botón que se encuentra en Excel en la hoja1 ("Hoja Selección"), su código está contenido en el código interno de la hoja1.
La hoja2 ("Elementos actualizados") es más o menos así:
Eje | Codo | Tubo |
D | 20 | H | 40 | D | 30 |
L | 300 | R | 30 | L | 150 |
-----------------------------------------
Private Sub Piezas_Click()
UserForm1.Show
End Sub
-------------------------------------------
A partir de aquí el código se encuentra dentro del propio libro de VBA en el UserForm
Private Sub UserForm_Initialize()
Sheets("Elementos actualizados").Select
'Seleccionamos la celda A1
Range("A1").Select
'Hasta que no encuentre una columna vacía
'que llene todo con datos
Do While ActiveCell <> Empty
ComboBox1.AddItem ActiveCell.value
'nos desplazamos una columna a la derecha
ActiveCell.Offset(0, 1).Select
Loop
End Sub
--------------------------------
Private Sub ComboBox1_Change()
ListBox1.Clear
Dim rngRango As Range
columna = (2 * ComboBox1.ListIndex + 1)
Sheets("Elementos actualizados").Select
Cells(2, columna).Select
Do While ActiveCell <> Empty
'nos desplazamos una columna a la derecha
ActiveCell.Offset(1, 0).Select
Loop
filaUlt = ActiveCell.Row
Set rngRango = Worksheets("Elementos actualizados").Range(Cells(2, columna), Cells(filaUlt, columna + 1))
Me.ListBox1.ColumnCount = rngRango.Columns.Count
Me.ListBox1.RowSource = rngRango.Address(external:=True)
Set rngRango = Nothing
End Sub
-------------------------------------------------
Private Sub ListBox1_Click()
columna = (2 * ComboBox1.ListIndex + 1)
fila = ListBox1.ListIndex + 2
Cells(fila, columna + 1).Select
TextBox1.value = ActiveCell.value
End Sub
-------------------------------------------------
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
columna = (2 * ComboBox1.ListIndex + 1)
fila = ListBox1.ListIndex + 2
If KeyCode = vbKeyReturn Then
Cells(fila, columna + 1) = TextBox1
End If
End Sub
Private Sub Aceptar_Click()
Unload UserForm1
End Sub
------------------------------------------
Cuando lo ejecuto paso a paso se ejecuta perfectamente hasta que llego al TextBox y le doy al Enter entonces se ejecuta el TextBox1_KeyDown hasta
If KeyCode = vbKeyReturn Then
Cells(fila, columna + 1) = TextBox1
Y de repente se vuelve a ejecutar el ListBox1_Click, este se ejecuta 2 veces, y vuelve a terminar al TextBox. Si hay suerte se ejecuta sin problemas sino puede que se cuelge en TextBox1_KeyDown en Cells(fila, columna + 1) = TextBox1 o en End Sub.
El error que me muestra es un error de en tiempo de ejecución y me lo situa en el botón:
Private Sub Piezas_Click()
UserForm1.Show
End Sub
Muchas gracias y perdona por la parrafada.
1 respuesta
Respuesta de Juan Carlos González Chavarría
1