Ajuda com Hiperlink VBA

Private Sub txtPesquisar_Change()
    TextoDigitado = txtPesquisar.Text
    Call PreencheLista
End Sub

Private Sub PreencheLista()
    Dim ws As Worksheet
    Dim i As Integer
    Dim TextoCelula As String
    Set ws = Worksheets("base")
    i = 1
    ListBox1.Clear
    With ws
        While .Cells(i, 1).Value <> Empty
            TextoCelula = .Cells(i, 1).Value
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                ListBox1.AddItem .Cells(i, 1)
                ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets("base").Range("B" & i)
                ListBox1.List(ListBox1.ListCount - 1, 2) = Worksheets("base").Range("C" & i)
                ListBox1.List(ListBox1.ListCount - 1, 3) = Worksheets("base").Range("D" & i)                
            End If
            i = i + 1            
        Wend
    End With
End Sub

Olá amigos, gostaria da ajuda de vocês para solucionar um problema. O código acima preenche um listbox num userform. Isso já funciona perfeitamente. Porém na minha planilha, na coluna D tenho hiperlinks. O que eu preciso é que quando for montar a coluna D  também carregue o hiperlink.

Da forma como está ele apenas mostra a coluna D com os caminhos, mas sem a função de hiperlink.