VBAのハイパーリンクにつきまして

質問

以前に質問をさせていただき、こちらでベストアンサーを決定した後に急きょ変更があったところがあり、わからなくなってしまいこちらに戻ってきた次第です。

http://okwave.jp/qa/q8743521.html

にて質問をさせていただきました内容について、以下のVBAで解決できております。
しかし、抽出したファイル名にハイパーリンクが欲しいという要望を受けてしまいました。
ハイパーリンクのＶＢＡについていろいろ調べましたが、この記述方法に追加して実行する方法が全く分かりませんでした。

お分かりになる方がいましたら、この内容にハイパーリンクをつける方法をお教えいただけますでしょうか。よろしくお願いいたします。

Sub Macro1()
Dim i As Long
Dim myPath As String, Flnm As String
ReDim Flnmfp(0) As String
Dim WS1 As worksheet
Set WS1=ThisWorkbook.sheets("sheet1")

myPath="望みのフォルダパスを入力"
Call fpFileName(myPath, Flnmfp ) 'フォルダ内のファイル名取得
If Ubound(Flnmfp)=0 Then 'フォルダにファイルが無ければ終了
Exit Sub
End if

For i =1 to Ubound(Flnmfp)
Workbooks.open filename := Flnmfp(i)
Flnm=Dir(Flnmfp(i))
With Workbooks(Flnm).sheets("sheet1")
WS1.Cells(2, i).value=.Range("G5").value
WS1.Cells(3, i).value=.Range("G6").value
WS1.Cells(4, i).value=.Range("K7").value
WS1.Cells(5, i).value=CStr(.Range("G9").value) & CStr(.Range("N9").value) & CStr(.Range("P9").value)
'同じ要領で望みのセルを記入する
WS1.Cells(8, i).value=Flnm
End with
Workbooks(Flnm).close Savechanges:=False

Next i
End Sub

Sub fpFileName(ByVal myPath As String, ByRef Flnmfp() As String)
'サブフォルダも含め全部のxlsファイル名をフルパスで取得する
　　Dim cnt As Long, buf As String, f As Object

　　buf = Dir(myPath & "\*.xls")
　　Do While buf <> ""
　　　　cnt = Ubound(Flnmfp) + 1
ReDim Preserve Flnmfp(cnt)
　　　　Flnmfp(cnt)= myPath & "\" & buf
　　　　buf = Dir()
　　Loop
　　With CreateObject("Scripting.FileSystemObject")
　　　　For Each f In .GetFolder(myPath).SubFolders
　　　　　　Call fpFileName(f.Path, Flnmfp)
　　　　Next f
　　End With
End Sub

回答No.2

High_Score · ベストアンサー

社内で出来る人が居ないなら、この機会に勉強してはどうですか？私もプログラマではなく、仕事上の必要から勉強した片手間VBAです。1年位ですよ。

ただし、手広くやり過ぎるとマクロ係みたいになって本業から外されるリスクがあるのでご注意を。

回答No.1

High_Score

For i=1 to Ubound(Flnmfp)の上に
WS1.HyperLinks.Delete
を追加。処理前に全ハイパーリンクを解除する。

Next iの上に
WS1.Hyperlinks.Add Anchor:=Cells(8, i), Address:=Flnmfp(i)