Criar Hyperlink automático

2024 - VBA & Macros

Post Recente por xmiguelx 8 anos atrás

4 Posts

3 Usuários

0 Reactions

1,131 Visualizações

RSS

xmiguelx

(@xmiguelx)

Posts: 34

Eminent Member

Topic starter

Olá pessoal!

estou tetando criar hyperlink automaticamente.

Criei um exemplo:

Ao clicar no botão Hyperlink gostaria de aplicar o link na coluna B para ser direcionado a Guia correspondente a coluna A.
Já consegui criar o Hyperlink, mas falta algo, pois não consigo direcionar a guia.

Sub CriarHiperlink()
    
    Dim lUltimaLinhaAtiva As Long
    Dim lControle As Long

    Application.ScreenUpdating = False

    lUltimaLinhaAtiva = Worksheets("INDEX").Cells(Worksheets("INDEX").Rows.Count, 1).End(xlUp).Row
        
    For lControle = 3 To lUltimaLinhaAtiva
        Range("B" & lControle).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
            Range("A" & lControle).Value, TextToDisplay:="" & Range("A" & lControle).Value
    Next lControle
End Sub

Obrigado.

TESTE_HYPERLINK.xlsm

Postado : 25/09/2016 5:21 pm

Trindade

(@trindade)

Posts: 278

Reputable Member

Bom dia, xmiguelx

Testa esse código

Sub CriarHiperlink()
    
    Dim lUltimaLinhaAtiva As Long
    Dim lControle As Long

    Application.ScreenUpdating = False

    lUltimaLinhaAtiva = Worksheets("INDEX").Cells(Worksheets("INDEX").Rows.Count, 1).End(xlUp).Row
        
    For lControle = 3 To lUltimaLinhaAtiva
        Range("B" & lControle).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
            "'" & Range("A" & lControle).Value & "'!A1", TextToDisplay:="" & Range("A" & lControle).Value
    Next lControle
End Sub

Esta referenciando para qual célula da planilha o link esta lhe direcionando.

Se a resposta foi útil! Clique na mãozinha ao lado do botão Citar.
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde.

Postado : 26/09/2016 8:14 am

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Bom dia!!

O que acha dessa rotina?

Private Sub Worksheet_Activate()
'http://www.ozgrid.com/VBA/sheet-index.htm
'O código deve ser posto dentro do módulo da guia
Dim wSheet As Worksheet
Dim l As Long

l = 1

    With Me
        .Columns(1).ClearContents
        .Cells(1, 1) = "INDEX"
        .Cells(1, 1).Name = "Index"
    End With
    

    For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name Then
            l = l + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                End With

                Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
        End If
    Next wSheet

End Sub

ou.

Sub AleVBA_21989()
Dim sh As Worksheet
Dim cell As Range
'Fonte:http://www.get-digital-help.com/2012/07/18/create-links-to-all-sheets-in-a-workbook/
For Each sh In ActiveWorkbook.Worksheets
    If ActiveSheet.Name <> sh.Name Then
        ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
        ActiveCell.Offset(1, 0).Select
    End If
Next sh
End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 26/09/2016 8:25 am