Activar libro y hoja dependiendo de dato en textbox
Tengo una base de datos de muchas hojas,
que visualizo con un useform y actualizo
información, como las hojas superan 300
el libro pesa demasiado y demora al guardar,
asimismo para ir a determinada hoja lo hago
a través del códico que adjunto.
Lo que quisiera es que el useform esté en un libro
de nombre "monitoreo" y que si en el textbox escribo
del 1 al 50 active el "libro 1" y seleccione la hoja
que figure en el textbox, si en el textbox escribo
del 51 al 100 active el "libro 2" y seleccione la hoja
que figure en el textbox, si en el textbox escribo
del 51 al 100 active el "libro 3" y seleccione la hoja
que figure en el textbox, y así sucesivamente.
En cada libro habrá 50 hojas,
Libro 1 hojas del 1 al 50
Libro 2 hojas del 51 al 100
Libro 3 hojas del 101 al 150
Libro 4 hojas del 151 al 200
Libro 5 hojas del 201 al 250
Libro 6 hojas del 251 al 300
Libro 7 hojas del 301 al 350
Libro 8 hojas del 351 al 400
Libro 9 hojas del 401 al 450
Libro 10 hojas del 451 al 500
Private Sub CommandButton1_Click()
On Error GoTo h
Dim nom As String
nom = "Hoja" & TextBox1
Sheets(nom).Activate
Exit Sub
h: MsgBox "DATO INCORECTO", vbCritical, "INGRESE UN NUMERO VALIDO"
Application.Quit
End Sub
1 Respuesta
Pon la siguiente macro en tu formulario.
Private Sub CommandButton1_Click()
'Por.Dante Amor
If Not IsNumeric(TextBox1) Then MsgErr = "Letras no permitidas"
If TextBox1 = "" Then MsgErr = "Escribe un número de hoja"
If Val(TextBox1) > 500 Then MsgErr = "Número de hoja inválido"
If MsgErr <> "" Then
MsgBox MsgErr, vbExclamation
TextBox1.SetFocus
Exit Sub
End If
'
Select Case Val(TextBox1)
Case 1 To 50: n = 1
Case 51 To 100: n = 2
Case 101 To 150: n = 3
Case 151 To 200: n = 4
Case 201 To 250: n = 5
Case 251 To 300: n = 6
Case 301 To 350: n = 7
Case 351 To 400: n = 8
Case 401 To 450: n = 9
Case 451 To 500: n = 10
End Select
'
On Error Resume Next
Set l2 = Workbooks("libro " & n)
If Err.Number <> 0 Then
Err.Number = 0
Set l2 = Workbooks.Open("libro " & n & ".xlsx")
If Err.Number <> 0 Then
MsgBox "El libro " & n & " no existe", vbCritical
TextBox1.SetFocus
Exit Sub
End If
End If
On Error GoTo 0
'
For Each h In l2.Sheets
If h.Name = "Hoja" & Val(TextBox1) Then
existe = True
Exit For
End If
Next
'
If existe Then
l2.Activate
Sheets("Hoja" & Val(TextBox1)).Select
Unload Me
Else
MsgBox "La hoja " & TextBox1 & " no existe", vbCritical
TextBox1.SetFocus
l2.Close False
Exit Sub
End If
End SubSaludos.Dante Amor
No olvides valorar la respuesta
Sencillamente genial, lo estoy probando y va funcionando a la perfección, cualquier duda que surgiera al interactuar con los datos te paso la voz.
Gracias.
Maestro Dante; cuando los libros estan abiertos, la macro corre a la perfección, al inicio la macro habria los libros aun cuando estaban cerrados, pero no se que paso y ya no habren.
El libro con el formulario lo tengo en otra carpeta, como hago para abrir los libros y hojas que voy ingresando en el textbox, ya que estos al final tienen que guardar los cambios efectuados y cerrarse al hacer click sobre un comando. gracias.
Deja el archivo con la macro en la misma carpeta
Maestro, ahora las deje en la misma carpeta pero tampoco abre, copie el código tal y conforme usted la brindó muy amablemente.
Cambie el nombre del "Libro1" por si acaso hay algún tipo de conflicto y también en el código, pero nada.
¿Qué otros cambios realizaste?
¿Por qué si funcionaba la primera vez y ahora no?
¿Los nombres de los libros siguen siendo los mismos?
¿Modificaste algo en la macro?
Después de esta línea
On error resume next
Agrega esta línea
ChDir ThisWorkbook. Path
Maestro, olvide mencionar sale el siguiente mensaje:
Maestro, de repente de algo no me doy cuenta por estar pegado al proyecto, este es el código conforme usted sugirió.
Private Sub CommandButton1_Click()
'Por.Dante Amor
If Not IsNumeric(TextBox1) Then MsgErr = "Letras no permitidas"
If TextBox1 = "" Then MsgErr = "Escribe un número de hoja"
If Val(TextBox1) > 500 Then MsgErr = "Número de hoja inválido"
If MsgErr <> "" Then
MsgBox MsgErr, vbExclamation
TextBox1.SetFocus
Exit Sub
End If
'
Select Case Val(TextBox1)
Case 1 To 50: n = 1
Case 51 To 100: n = 2
Case 101 To 150: n = 3
Case 151 To 200: n = 4
Case 201 To 250: n = 5
Case 251 To 300: n = 6
Case 301 To 350: n = 7
Case 351 To 400: n = 8
Case 401 To 450: n = 9
Case 451 To 500: n = 10
End Select
'
On Error Resume Next
ChDir ThisWorkbook.Path
Set l2 = Workbooks("libro " & n)
If Err.Number <> 0 Then
Err.Number = 0
Set l2 = Workbooks.Open("libro " & n & ".xlsx")
If Err.Number <> 0 Then
MsgBox "El libro " & n & " no existe", vbCritical
TextBox1.SetFocus
Exit Sub
End If
End If
On Error GoTo 0
'
For Each h In l2.Sheets
If h.Name = "Hoja" & Val(TextBox1) Then
existe = True
Exit For
End If
Next
'
If existe Then
l2.Activate
Sheets("Hoja" & Val(TextBox1)).Select
Unload Me
Else
MsgBox "La hoja " & TextBox1 & " no existe", vbCritical
TextBox1.SetFocus
l2.Close False
Exit Sub
End If
End Sub
No entiendo cuál es el problema, si ya funcionaba al principio.
¿Modificaste la macro?
Los libros en la carpeta se tienen que llamar así:
"Libro 1"
Es decir, la palabra "libro" un espacio y después el número
Se solucionó, elimine el libro donde estaba el formulario y volví a crear en otro libro y pegar el código, sin embargo no entiendo por que ya no funcionaba en el otro libro.
Pero no todo lo debemos entender ni saber, por que hay siempre algo que aprender de los demás.
Maestro
¡Gracias!
