Criar hiperlinks automaticamente no Excel com VBA

Objetivo: Criar hiperlinks para uma lista de dados de forma automática. No exemplo usei pacotes dos Correios.

Em determinados casos temos a necessidade de criar hiperlinks para uma lista de dados de forma automática.

Estas situações podem ser por exemplo para acompanhar pacotes dos correios, encomendas em transportadoras, podendo ser amplamente utilizado em conjunto com o Sharepoint, criando poderosos relatórios.

Como não tenho o Sharepoint instalado aqui fiz com o site dos correios, mas o princípio é o mesmo. O lugar aonde está apontando o endereço da célula seria o número do registro no Sharepoint no caso. Veja a nova planilha  para rastreamento correio no Excel.

Abaixo todo o código fonte utilizado:

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

    Application.ScreenUpdating = False

    lUltimaLinhaAtiva = Worksheets("Lista de Encomendas").Cells(Worksheets("Lista de Encomendas").Rows.Count, 1).End(xlUp).Row
        
    For lControle = 2 To lUltimaLinhaAtiva
        Range("A" & lControle).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
            "http://websro.correios.com.br/sro_bin/txect01$.QueryList?P_LINGUA=001&P_TIPO=001&P_COD_UNI=" & _
            Range("A" & lControle).Value, TextToDisplay:="" & Range("A" & lControle).Value
    Next lControle
End Sub

Sub RemoverHiperlink()

    Dim lUltimaLinhaAtiva As Long
    Dim lControle As Long

    Application.ScreenUpdating = False

    lUltimaLinhaAtiva = Worksheets("Lista de Encomendas").Cells(Worksheets("Lista de Encomendas").Rows.Count, 1).End(xlUp).Row
        
    For lControle = 2 To lUltimaLinhaAtiva
        Range("A" & lControle).Select
        Selection.Hyperlinks.Delete
    Next lControle
End Sub
Baixe a planilha

Abraço

Marcos Rieper

Sair da versão mobile