Macro para Exibir, Inserir ou Remover os Hiperlinks das suas Planilhas

Olá Excelentes pessoas!!! Tudo bem com vocês?

A dica de hoje é para quem curte VBA. Vou ensinar como manipular a coleção Hyperlinks, que representa todos os links presentes em uma planilha, seja com direcionamento interno (entre planilhas) ou externo  (sites, emails).

Pode ser uma funcionalidade muito útil em qualquer projeto, principalmente naqueles que envolvam ambientes em rede, internet, enfim, você vai adaptar os exemplos abaixo de acordo com suas necessidades.

Você sabia que, além desta maneira de movimentar-se por suas planilhas, você poderia criar menus e atalhos para acessar as planilhas da sua pasta de trabalho usando uma ligação por hiperlinks?

Poderia, também, configurar endereços (urls) dinâmicos para acessar sites que dependam de parâmetros específicos e que podem ser obtidos em tabelas de dados em suas planilhas. Observe  um exemplo:

Você tem uma planilha com a listagem dos códigos de downloads do site. Na coluna A teremos os códigos. Suponha que vamos montar a url para acessar o download de número 1, que está na célula A1. Seria algo mais ou menos assim:

= “https://www.exceldoseujeito.com.br/downloads/?download_id=” & A1

Desta forma, definiríamos a url dinâmica e poderíamos incluí-la na macro.

Isto é apenas um exemplo, na prática você irá perceber melhor como funciona. Existe muita coisa a aprender a respeito, contudo, para não ficar cansativo vamos mostrar apenas algumas técnicas e exemplos neste artigo.

O que vamos aprender?

• Listar todos os Hiperlinks usados nas Planilhas da Pasta de trabalho
• Remover todos os links
• Adicionar um novo Hiperlink
• Acessar um Hiperlink

 

Boa leitura!

Listando todos os Hiperlinks da planilha

No exemplo a seguir, você observa o código para gerar uma lista com todos os hiperlinks encontrados em todas as planilhas da pasta de trabalho atual. O código desta macro deverá ser incluído num Módulo no seu VBAProject (para acessar o ambiente de desenvolvimento tecle ALT+F11).

O código a seguir está bem comentado em suas funcionalidades, mas, qualquer dúvida que vocês encontrem, postem nos comentários, ok.

Importante: Crie uma planilha e dê o nome “ReportHiperLinks” ou troque, na linha 10, o nome da planilha que vai receber o relatório.

Public Sub Exibir_HiperLinks()
Dim lnk As Hyperlink
Dim sh As Worksheet
Dim shRelatorio As Worksheet
Dim r As Long

On Erro GoTo Erro_Rotina

    'Define a planilha onde será listado o resultado
    Set shRelatorio = ThisWorkbook.Sheets("ReportHiperLinks")

    'Limpar o relatório
    shRelatorio.Cells.Clear

    'Monta o cabeçalho do Relatório
    r = 1
    With shRelatorio
        'Escreve e Formata o Título
        With .Cells(r, 1)
            .Value = "Relação de Hiperlinks"    'Escreve o título do relatório
            .Font.Size = 16                     'Tamanho da letra
            .Font.Bold = True                   'Negrito
        End With
        r = r + 2

        'Escreve o cabeçalho
        .Cells(r, 1) = "Local do Link (Planilha)"
        .Cells(r, 2) = "Local do Link (Célula)"
        .Cells(r, 3) = "Texto do Link"
        .Cells(r, 4) = "URL do Link"
        .Cells(r, 5) = "Visitar"
        .Cells(r, 6) = "Remover"

        'Aplica algumas formatações nas células
        With .Range(.Cells(r, 1), .Cells(r, 6))
            .Font.Bold = True                   'Negrito
            .Interior.Color = RGB(0, 0, 0)      'Fundo Preto
            .Font.Color = RGB(255, 255, 255)    'Cor da letra Branca
            .VerticalAlignment = xlCenter       'Centralizado
            .WrapText = True                    'Quebrar texto
        End With
        With .Range(.Cells(r, 5), .Cells(r, 6))
            .HorizontalAlignment = xlCenter     'Centralizado
        End With
    End With
    r = r + 1

    'Pesquisa os HiperLinks
    For Each sh In ThisWorkbook.Worksheets
        For Each lnk In sh.Hyperlinks
            With shRelatorio
                .Cells(r, 1) = lnk.Range.Worksheet.Name
                .Cells(r, 2) = Replace(lnk.Range.Address, "$", "")
                .Cells(r, 3) = lnk.TextToDisplay
                .Cells(r, 4) = lnk.Address
                .Cells(r, 5) = "Clique para Visitar"
                .Cells(r, 6) = "Clique para Remover"

                'Aplica algumas formatações nas células
                With .Cells(r, 5)
                    .HorizontalAlignment = xlCenter     'Centralizado
                    .Interior.Color = RGB(0, 0, 255)    'Fundo Azul
                    .Font.Color = RGB(255, 255, 255)    'Cor da letra Branca
                End With
                With .Cells(r, 6)
                    .HorizontalAlignment = xlCenter     'Centralizado
                    .Interior.Color = RGB(255, 0, 0)    'Fundo Vermelho
                    .Font.Color = RGB(255, 255, 255)    'Cor da letra Branca
                End With
            End With
            r = r + 1   'Adiciona linha
        Next lnk
    Next sh

    'Mostra o relatório
    shRelatorio.Select

    MsgBox "Listagem de HiperLinks Gerada.", vbInformation, "Excel do Seu Jeito"

Exit Sub
Erro_Rotina:
    MsgBox Err.Description, vbExclamation
    Exit Sub
End Sub

 

Ao chamar a macro Exibir_HiperLinks() será gerado o relatório. Você pode criar um botão para atribuir sua macro e chamá-la sempre que clicar neste botão.

 

Remover todos os Hiperlinks das planilhas

De forma semelhante a macro anterior, você deverá colocar o código abaixo num Módulo. Para ativar a macro, chame a rotina Remover_HiperLinks().

Essa macro não exclui os textos das células que contém os links. Apenas elimina suas ligações. Veja como funciona na prática, baixando o arquivo pronto no final deste artigo.

Public Sub Remover_HiperLinks()
Dim lnk As Hyperlink
Dim sh As Worksheet

On Erro GoTo Erro_Rotina

    For Each sh In ThisWorkbook.Worksheets
        For Each lnk In sh.Hyperlinks
            lnk.Delete
        Next lnk
    Next sh

    MsgBox "Links Removidos", vbInformation, "Excel do Seu Jeito"

Exit Sub
Erro_Rotina:
    MsgBox Err.Description, vbExclamation
    Exit Sub
End Sub

 

Adicionar um HiperLink dinamicamente

No exemplo a seguir, mostrarei como inserir uma hiperligação via código. Esse código, como disse, pode ser dinamizado para construir URLs configuráveis ou com base em dados de suas planilhas, como parâmetros de nomes, assuntos, emails, enfim, o que for necessário no projeto.

Aqui vamos chamar uma caixa de entrada onde o usuário poderá digitar a url a ser linkada e o hiperlink será adicionado na célula ativa no momento da chamada à macro.

Public Sub Adicionar_HiperLinks()
Dim url As String
Dim texto As String

On Erro GoTo Erro_Rotina

    url = InputBox("Informe a URL do site", "Excel do Seu Jeito", "https://www.exceldoseujeito.com.br/loja/index.php?product_id=32578&utm_source=aplicativo-exemplo&utm_medium=aplicativo&utm_content=exemplo-hiperlink-add&utm_campaign=indicacao-ebook-exemplo-planilha")
    texto = IIf(Len(ActiveCell.Value) = 0, "Link Inserido pela Macro", ActiveCell.Value)

    If Len(url) > 0 Then
        ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=url, TextToDisplay:=texto
        MsgBox "Link Inserido", vbInformation, "Excel do Seu Jeito"
    End If

Exit Sub
Erro_Rotina:
    MsgBox Err.Description, vbExclamation
    Exit Sub
End Sub

 

Acessar um Hiperlink via código

Dessa maneira, você poderá acessar qualquer hiperlink sem precisar clicar no link propriamente dito.

Perceba que no código para listar os hiperlinks, eu adicionei duas colunas extras: uma para acessar o link e outra para excluir o link correspondente. Ou seja, o usuário ao clicar numa dessas células irá chamar a função correspondente para o link mostrado naquela linha respectiva.

Para funcionar, cole o código abaixo no módulo da planilha ReportHiperLinks.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim nome_planilha As String
Dim celula_link As String

On Erro GoTo Erro_Rotina

    With Target
        If .Columns.Count = 1 And .Rows.Count = 1 Then
            Select Case .Column
                Case 5      'Abrir HiperLink
                    If Len(.Value) > 0 Then
                        ThisWorkbook.FollowHyperlink .Offset(0, -1).Value
                    End If

                Case 6      'Remover HiperLink
                    If Len(.Value) > 0 Then
                        nome_planilha = .Worksheet.Cells(.Row, 1).Value
                        celula_link = .Worksheet.Cells(.Row, 2).Value
                        With ThisWorkbook.Sheets(nome_planilha).Range(celula_link)
                            If .Hyperlinks.Count > 0 Then
                                .Hyperlinks(1).Delete
                                MsgBox "HiperLink removido", vbInformation, "Excel do Seu Jeito"
                            End If
                        End With
                    End If
            End Select
        End If
    End With

Exit Sub
Erro_Rotina:
    MsgBox Err.Description, vbExclamation
    Exit Sub
End Sub

 

Qualquer dúvida postem aqui nos comentários. O arquivo utilizado nos exemplos está disponível para download logo no final do artigo.

 

Espero que tenham gostado.

Ajude-nos a ajudá-los melhor e produzir mais conteúdos interessantes. Compartilhe com seus amigos no Facebook, Twitter, enfim, como puder.

Até a próxima.