Excelのセルにpdfファイルをリンクしたい

質問

タイトルの通り、エクセルのセルにpdfファイルをリンクしたいのですが、いくつかの規制があり、困っています。
１、リンクを貼るセルには「*12345」と表示させ、
　　「12345.pdf」へリンクさせたい。
２、ＣＤへコピーさせてもリンクが有効であるようにしたい。
３、上記１、２を３００件ほど行うので出来るだけ操作を簡略化したい。
以上のことで分かる方がいらっしゃいましたらご教授下さい。
マクロを使っても構わないのですが、当方マクロに不慣れなために詳しい説明をお願いします。

回答No.4

kaekaekaede · ベストアンサー

すいません。先ほど回答した内容に不備がありました。
以下の内容を参照してください。

Option Explicit
Sub test()
Dim wbdata As Workbook
Dim wsdata As Worksheet
Dim ptthis As String
Dim rowmax As Integer
Dim fname As Range

Set wbdata = Workbooks("Book1.XLS")
Set wsdata = wbdata.Worksheets("Sheet1")

ptthis = wbdata.Path

rowmax = 0
Do Until IsEmpty(wsdata.Cells(1.1).Offset(rowmax, 0).Value)
Set fname = wsdata.Cells(1.1).Offset(rowmax, 0)
wsdata.Hyperlinks.Add Anchor:=fname, Address:=ptthis & "\" & Right(fname.Value, 5) & ".pdf"
rowmax = rowmax + 1
Loop
End Sub

お礼

kaekaekaedeさん、回答ありがとうございました。
おかげでリンク作業が軽減されました。

回答No.5

noname#29107

質問者さんのお望みは、先に「???12345」などを手入力しておいて、リンクが貼れるようにするというのでよろしいですか？それでしたら＃３さんの回答でいいと思います。
ただ、最後にCD-Rに焼いてということですと、
wsdata.Hyperlinks.Add Anchor:=fname, Address:=ptthis & "\" & Right(fname.Value, 5) & ".pdf"
のところを
wsdata.Hyperlinks.Add Anchor:=fname, Address:=".\" & Right(fname.Value, 5) & ".pdf"
に変更すべきかと思います。そうすれば階層が変わらない限りCD-Rに移動してもうまくいくと思います。

もし、「???12345」はまだ入力してないというのでしたら、次のソースも良いかもしれません。
Sub testlst()
Dim MyFl As String, MyPth As String
Dim ix As Long

ix = 1
MyPth = ActiveWorkbook.Path & "\"
MyFl = Dir(MyPth & "*.pdf")
Do While MyFl <> ""
　　ActiveSheet.Hyperlinks.Add Anchor:=Cells(ix, 1), Address:=".\" & MyFl, _
　　　　TextToDisplay:=Left(MyFl, Len(MyFl) - 4)
　　ix = ix + 1
　　MyFl = Dir
Loop
End Sub
自動的にブックと同一のフォルダーの中のPDFファイルを書き出していきます。「????」の部分は考慮していませんが。

お礼

rebellionさん、回答ありがとうございました。
「????」に関しては、フリーソフトを利用してファイル名を一括で揃えることで解決しようと思います。どうもありがとうございました。

回答No.3

kaekaekaede

ファイル名：Book1.XLS、シート名：Sheet1の場合以下のでlinkをはれませんか？
注意：
・ブック名、シート名が異なる場合は
Set wbdata = Workbooks("Book1.XLS")
Set wsdata = wbdata.Worksheets("Sheet1")のBook1.XLS、Sheet1をそれぞれ任意の名前に変更して下さい。
・pdfファイルと、Excelファイルを同一フォルダーに保存して下さい。

Option Explicit
Sub test()
Dim wbdata As Workbook
Dim wsdata As Worksheet
Dim ptthis As String
Dim rowmax As Integer
Dim fname As Range

Set wbdata = Workbooks("Book1.XLS")
Set wsdata = wbdata.Worksheets("Sheet1")

ptthis = wbdata.Path

rowmax = 0
Do Until IsEmpty(wsdata.Cells(1.1).Offset(rowmax, 0).Value)
rowmax = rowmax + 1
Set fname = wsdata.Cells(rowmax, 1)
wsdata.Hyperlinks.Add Anchor:=fname, Address:=ptthis & "\" & Right(fname.Value, 5) & ".pdf"
Loop
End Sub

回答No.2

noname#29107

もう少し条件を具体的に示して頂かないと、何を答えてよいのやら判断できません。

とりあえず想像でアドバイスを・・・
１）12345.pdfというファイル名が分かっているとします。A2セルに入力されているとします。PDFの保存されているフォルダーは、"D:\pdfdata"であるとします。
この時、B2セルに
=HYPERLINK("D:\pdfdata\"&A1,"*"&LEFT(A1,LEN(A1)-4))
とするとB2セルにハイパーリンクが付きます。

２）CDにコピーしてもというのは、CD-Rに移動したら自動的にリンクを張り直すということでしたら無理でしょう。パスが決まっているなら、１）と同様にして、CD用のリンクを作ればよいと思います。

３）ファイル名の一覧があれば、上記の応用で出来ますが、PDFの入っているフォルダーの構造は複雑なんでしょうか？一つのフォルダーに入っているなら一覧を作るのも簡単でしょう。

マクロについては、どこから説明する必要があるのかがちょっと分かりません。マクロをどうやってブックで動かせるようにするのかから、説明する必要があるのかどうか？

補足

rebellionさん、回答ありがとうございます。
質問をより具体的に示しますと、
まず、セルＡ１に「???12345」と表示させ（???は半角、全角を含む任意の文字列）、
セルＡ１をクリックするとExcelデータと同じ階層にあるフォルダの中にある12345.pdfファイルが開くようにしたいのです。
最終的にExcelファイルとpdfファイルをCD-Rに移動したいのですが、移動した後もリンクが有効であるようにする方法を求めています。
マクロについては、Alt + F11で開いて、標準モジュールの挿入でプログラムを編集し、Alt + Qで閉じる。更新する場合にはマクロを開いてF5を押す。この程度です。宜しくお願いします。

回答No.1

kaekaekaede

ハイパーリンクを利用するでは、いけないのですか？
表示文字列を*12345とし、参照先のファイル名を指定すると一応、開くことは出来ますよ。

お礼

kaekaekaedeさん、回答ありがとうございます。
質問に不備があったようで、申し訳なく思っています。
*12345というのは、*に任意の文字列があるという意味で使ったのですが、説明が足りなかったようです。
ハイパーリンクは使えるのですが、使いこなせていないようで困っています。