こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBAでハイパーリンクをつける

仕事で画像のファイル名をExcelに書き出し、書き出しものにハイパーリンクで見がうまくいきません。下記のものです。どこが悪いのでしょうか?
Option Explicit
Dim ドライブ As String
Dim フォルダ As String
Dim 拡張子 As String
Dim 記入シート As String
Dim パス As String
Dim ファイル名 As String
Dim 貼付行 As Integer
Sub フォルダ中のファイル名をシートに書く()
ドライブ = "C"
フォルダ = "分析"
拡張子 = "*." & "JPG"
記入シート = "ファイル一覧"
End Sub
Private Sub 指定フォルダ中の指定拡張子のファイル名をシートに書く()
Sheets(記入シート).Activate
Cells.Clear
Range("A1").Select
パス = ドライブ & ":\" & フォルダ & "\"
ファイル名 = Dir(パス & 拡張子)
貼付行 = 0
Do While ファイル名 <> ""
貼付行 = 貼付行 + 1
Cells(貼付行, 1).Value = ファイル名
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ファイル名, TextToDisplay:=ファイル名
ファイル名 = Dir()
Loop
End Sub
実行すると初めの一行だけリンクができ後は一行もできません。よろしくお願い致します。

投稿日時 - 2006-10-18 22:01:57

QNo.2481629

すぐに回答ほしいです

質問者が選んだベストアンサー

>Anchor:=Selection
になってるからじゃないですか
Anchor:=Cells(貼付行, 1)
にしてみたらどうでしょう

投稿日時 - 2006-10-19 03:20:31

補足

できました!ありがとうございます。
TextToDisplayで拡張子が○○○.jpgと着きますが
この拡張子無しで表示したいのですが
この部分を消しても意味はないのですね。
(1)Dim 拡張子 As String
(2)拡張子 = "*." & "JPG"
(3)ファイル名 = Dir(パス & 拡張子)⇒この「&拡張子」の部分
たぶんこのDirに意味があるのでしょうか?

投稿日時 - 2006-10-19 21:44:21

お礼

できました。ありがとうございます。
ディスプレイの拡張子をはぶくものは
別で、質問したいと思います。
ありがとうございました。

投稿日時 - 2006-10-19 23:50:42

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

ANo.1の方の方法でもいいですが、そうすると下記の※の部分の意味がなくなります。
且つそこが問題点なのですが・・・

Private Sub 指定フォルダ中の指定拡張子のファイル名をシートに書く()
  Sheets(記入シート).Activate
  Cells.Clear
  Range("A1").Select '※
  パス = ドライブ & ":\" & フォルダ & "\"
  ファイル名 = Dir(パス & 拡張子)
  貼付行 = 0
  Do While ファイル名 <> ""
    貼付行 = 貼付行 + 1
    Cells(貼付行, 1).Value = ファイル名
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ファイル名, TextToDisplay:=ファイル名
    ファイル名 = Dir()
  Loop
End Sub

※の箇所で選択しているのはA1のセルのみです。
一方で、ActiveSheet.Hyperlinks.Addメソッドで、Anchor:=SelectionとしてSelectionプロパティ
を指定していますから、選択されている部分しか追加されません。
従って、Range("A1").Selectで選択されているセルにしか追加されません。

【対処方法】

  Do While ファイル名 <> ""
    貼付行 = 貼付行 + 1
    Range("A" & CStr(貼付行).Select   ’変更点
    Selection.Value = ファイル名     ’変更点
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ファイル名, TextToDisplay:=ファイル名
    ファイル名 = Dir()
  Loop

という形にして、逐次セル単位でセレクトをかける形にすればいいと思います。
動作確認:Windows2000 Professional SP2、Office2000

投稿日時 - 2006-10-19 05:07:16

あなたにオススメの質問