¿Buscar valor y abrir el hipervínculo de la celda encontrada?
Soy un poco novato en esto, estoy intentando hacer un sistema de gestión simple para ir automatizando una pequeña empresa, en este caso, estoy complicado con la opción para buscar un valor dentro de una celda y que se ejecute el hipervínculo de dicha celda. He ido copiando algunas ideas, macros y formularios, en este caso tengo un cuadro de búsqueda que funciona bien, busca, encuentra y muestra el hipervínculo, cuando no encuentra el valor, aparece de manera correcta el mensaje que no se ha encontrado el documento, pero, el problema viene aquí, cuando encuentra un valor, pero esta celda no tiene hipervínculo asociado, me manda a depurar. Agradecería me pudieran ayudar.
Private Sub CommandButton1_Click()
Worksheets("Compras").Activate
Set resp = Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If resp Is Nothing Then
Worksheets("Menu").Activate
MsgBox ("NO SE ENCONTRÓ EL DOCUMENTO Nº " & TextBox1.Value), vbInformation
Else
resp.Activate
ActiveCell.Offset(0, 0).Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=False
End If
TextBox1 = ""
TextBox1.SetFocus
End Sub
Private Sub CommandButton2_Click()
Unload Me
Worksheets("Menu").Activate
End Sub
Private Sub Label1_Click()
End Sub
1 Respuesta
H o l a:
Te presento 2 opciones, la primera, obtiene el número de error, si es diferente de 0, significa que hay un error:
Private Sub CommandButton1_Click()
Worksheets("Compras").Activate
Set resp = Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If resp Is Nothing Then
Worksheets("Menu").Activate
MsgBox ("NO SE ENCONTRÓ EL DOCUMENTO Nº " & TextBox1.Value), vbInformation
Else
resp.Select
'Act.Por.Dante Amor
On Error Resume Next
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=False
If Err.Number <> 0 Then
MsgBox "La celda no tiene hipervículo", vbExclamation
End If
On Error GoTo 0
End If
TextBox1 = ""
TextBox1.SetFocus
End SubLa segunda opción (recomendable), es verificar si la celda tiene hpervículo:
Private Sub CommandButton1_Click()
Worksheets("Compras").Activate
Set resp = Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If resp Is Nothing Then
Worksheets("Menu").Activate
MsgBox ("NO SE ENCONTRÓ EL DOCUMENTO Nº " & TextBox1.Value), vbInformation
Else
resp.Select
'Act.Por.Dante Amor
For Each lnk In Selection.Hyperlinks
existe = True
Next
If existe = False Then
MsgBox "La celda no tiene hipervículo", vbExclamation
Else
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=False
End If
End If
TextBox1 = ""
TextBox1.SetFocus
End Sub
Amigo, primero que todo muchas gracias!
Ambos códigos funcionan bien, obviamente conservé el que me recomiendas. Tengo una sola duda y si pudieras ayudarme. Solo como para complementar el formulario de consulta, ¿cómo puedo hacer que este código busque en una hoja y rango determinado? Es decir... quiero ver la posibilidad de hacer una pantalla de bienvenida, tipo menu y desde ahí ejecutar la consulta, sin necesidad de que se active o se muestre la hoja de búsqueda.
Para ese caso hay que hacer referencia a la hoja y al rango:
Private Sub CommandButton1_Click()
'Por.Dante Amor
Set h1 = Worksheets("Compras")
Set b = h1.Range("C1:C100").Find(TextBox1.Text, LookAt:=xlWhole)
If b Is Nothing Then
MsgBox "NO SE ENCONTRÓ EL DOCUMENTO Nº " & TextBox1.Value, vbExclamation
Else
For Each lnk In b.Hyperlinks
existe = True
Next
If existe = False Then
MsgBox "La celda no tiene hipervículo", vbExclamation
Else
b.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=False
End If
End If
TextBox1 = ""
TextBox1.SetFocus
End Subsal u dos
