VBA Button Code

1

Good,

I created a file (query database) where each number corresponds to a PDF (hyperlink). I tried to create a USERFORM to search the PDF through No. and it is up to date. I would like to press the View button and open the PDF but I can not.

PrivateSubTextBox1_Change()DimintervaloAsRangeDimtextoAsStringDimcodigoAsIntegerDimpesquisaDimmensagemcodigo=TextBox1.TextSheets("Folha1").Select
Set intervalo = Range("A2:B10")

pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 2, False)

TextBox2.Text = pesquisa


End Sub


'Código do Botão Ver

Private Sub CommandButton1_Click()
If TextBox2 = "" Then
    MsgBox "Insira o nº da ficha a consultar."
End If

TextBox2.SetFocus

End Sub

I need help to create the code for the view-> tab

    
asked by anonymous 30.01.2018 / 15:03

1 answer

0

To resolve your issue, simply use the Hyperlink.Follow in the desired cell:

ActiveSheet.Range("b2").Hyperlinks(1).Follow

Then to find the hyperlink, the .Find method is used. Refer to this answer for more information on find methods.

Private Sub CommandButton1_Click()
Dim F1 As Worksheet
Dim intervalo As Range
Dim LastRow As Long
'Declara a Planilha pelo nome
Set F1 = ThisWorkbook.Worksheets("Folha1")
'Última Linha
LastRow = F1.Cells(F1.Rows.Count, "A").End(xlUp).Row

Set intervalo = F1.Range("A2:A" & LastRow)
'Caso não encontre TextBox2
If TextBox2 = "" Then
    MsgBox "Insira o nº da ficha a consultar."
'Se os campos de TextBox estiverem preenchidos
ElseIf TextBox2 > "" And TextBox1 > "" Then
'Realiza a procura
    With intervalo
        Set cellFound = .Find(TextBox1, LookIn:=xlValues)
        If Not cellFound Is Nothing Then
            FirstAddress = cellFound.Address
            Do
                'Realiza Ação após encontrar, faz offset de uma coluna para direita e segue o hyperlink. Então após encontrar na Coluna A, segue o hyperlink da coluna B.
                cellFound.Offset(0, 1).Hyperlinks(1).Follow
                Set cellFound = .FindNext(cellFound)
            Loop While Not cellFound Is Nothing And cellFound.Address <> FirstAddress
        End If
    End With
End If
TextBox2.SetFocus

End Sub

And to avoid using .Select find code and fill in value in TextBox2, can be changed to:

Private Sub TextBox1_Change()
    Dim intervalo As Range
    Dim texto As String
    Dim codigo As Integer
    Dim pesquisa
    Dim mensagem
    Dim F1 As Worksheet
    Set F1 = ThisWorkbook.Worksheets("Folha1")
    LastRow = F1.Cells(F1.Rows.Count, "A").End(xlUp).Row
    codigo = TextBox1.Text

    Set intervalo = F1.Range("A2:B" & LastRow)

    pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 2, False)

    TextBox2.Text = pesquisa


End Sub
    
30.01.2018 / 20:18