1

Boas,

criei um ficheiro (base dados consulta) em que a cada número corresponde um PDF (hiperligação). Tentei criar uma USERFORM para procurar o PDF através do Nº e até aqui está a funcionar. Gostava de carregar no botão Ver e abrir o PDF mas não estou a conseguir. inserir a descrição da imagem aqui

Private Sub TextBox1_Change()
Dim intervalo As Range
Dim texto As String
Dim codigo As Integer
Dim pesquisa
Dim mensagem

codigo = TextBox1.Text
Sheets("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

Preciso de ajuda para criar o código da tecla ver->ficha

1 Resposta 1

0

Para resolver seu problema, basta usar o Hyperlink.Follow na célula desejada:

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

Então para encontrar o hyperlink, o método .Find é usado. Refira a esta resposta para mais informações dos métodos de localizar.

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

E para evitar o uso de .Select o código de encontrar e preencher o valor em TextBox2, pode ser mudado para:

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

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .