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 SubBaixe a planilha
Abraço
Marcos Rieper