マクロによるハイパーリンクの自動化

Question

下記URLの質問と回答を参考にマクロを組もうとしています。
https://oshiete.goo.ne.jp/qa/2966602.html

具体的には

2枚目のシートのC列に入力されている文字(4文字の数字です)に
指定フォルダに入っている先頭4文字が一致するファイルをハイパーリンクする

といった処理を行おうとしています。

Sub AAA()
　Dim i As Integer, N As Integer, TargetFile As String
　i = 1
　Do While Cells(i, 3) <> ""
　　N = 0
　　TargetFile = Dir$("指定フォルダアドレス\*.xlsm")
　　Do While TargetFile <> ""
　　　If Left(TargetFile, 4) = Cells(i, 3) Then
　　　　ActiveSheet.Hyperlinks.Add Anchor:=Range(Cells(i, 3).Address), _
　　　　　　　　　　Address:="指定フォルダアドレス" & TargetFile
　　　　GoTo Nxt
　　　End If
　　　TargetFile = Dir$
　　Loop
Nxt: i = i + 1
　Loop
End Sub

実行をするとエラーが出ることもなくうんともすんともいいません。
間違いの指摘やアドバイスなどいただけますと幸いです。
よろしくお願いします。

WindFaller · Accepted Answer

こんにちは。

私のセキュリティの場合、ハイパーリンク設定はあっても、メッセージが出て、開かないので、一応、その話は置いておきます。誰もおなじだと思っていたからです。

◎先頭の4文字の一致でリンクを貼る様にしたい場合どのようにしたらよろしいでしょうか？

>C列が111となり、ファイル名が 『111 名前 所属.xlsm』の場合リンクが貼られずうんともすんとも言わない、といった状況です。

この場合は、先頭の4文字は、一意でおなじものがないという条件ですね。つまりインデックスというわけです。

>If Left(TargetFile, 4) = Cells(i, 3) Then
それで、元のコードでは、こうなっていたわけですね。(この場合の文字比較は、ちょっと難しいです。）

私のコードは、ひとつ変えれば済むだけです。

私の考え方は、[111 名前 所属.xlsm]というファイル名のあるファイルを探して、あるか・ないか、というのが、目的となっていますから、

'//以下、2行の書き換えで済むはずです。

fn = Trim(Left$(Cells(i, 3).Value, 4))  '①
TargetFile = Dir$(指定フォルダ & fn & "*.xlsm", vbNormal)

'//
".xlsm" → "*.xlsm" と、アスタリスクを入れてください。 (.xlsx, .xlsm, .xls を探すなら、[xls?] です。）
それと、念の為に、Trim 関数を用いました。

>C列の数字が68となっている場合、②のファイルを認識してリンクをはるということが可能なのでしょうか？
'①で、先頭の数字を探すというとこですね。それを間違えてしまうと、探しだせません。つまり、C列は、数字のみが入っているという条件ですね。

でしたら、問題はありません、数字にダブりがないことが条件です。

それと、余計な心配ですが、見つからなかった場合の記録を残すなら、以下のような方法でも可能です。

If TargetFile <> "" Then　(ファイルが見つかった場合）
　
　Else
　　　''見つからなかった場合は、
　　　Debug.Print fn
　　　fn=""
　End If

>手動でファイル名とC列の数字に0を足すなどして対応しようと思います。
>(5⇒0005)のように
ゼロパディングですね。これ自体、マクロでも可能です。
手順は、手動でやるのと同じことですが、VBAマクロなら早いというだけです。
ただ、タイム・スタンプをそのままに残すというと、ちょっとややこしいような気がしました。これも可能だと思います。

それにしても、私も、これを手本にして、ファイルの整理をしようかと思うようになりました。いつも、月末にファイルを探していますからね。（^^;

WindFaller · Answer

追伸：

今、実際のハイパーリンクを試してみましたが、これがうまくありませんね。セキュリティが働いてしまい、容易に開けようとしません。以下のようなメッセージが出てしまいます。

問題なければ、それはそれで、こちらの早合点かもしれません。

私の場合は、ハイパーリンクがないほうがよいです。
今は、ハイパーリンクがあることが条件になっていますから、右クリックにイベントを設けましたが、ハイパーリンクとは、時間的に開くのに雲泥の差があります。

当該のハイパーリンクのシートの、「シートモジュール」に、以下のようなマクロを付けてみてください。
ハイパーリンクがなければ、
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

こちらのほうがよいです。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim fn As String
Cancel = True
　If Target.Hyperlinks.Count > 0 Then
　　　　fn = Target.Hyperlinks(1).Address
　　　　If Dir(fn) <> "" Then
　　　　　　Workbooks.Open fn
　　　　End If
　End If
End Sub

WindFaller · Answer

人様の作ったものの評価はしませんが、このコード、見た感じ、変だと思いましたが、こちらで作ってみました。

要するに、その名称のファイルがあるかどうかの問題ですから、考え方は逆なのです。一応、「.xlsm」は、汎用性のために「.xls?」にしましたが、問題がなければ、元に戻してください。
　
'//
Sub BBB()
　　Dim i As Integer
　　Dim TargetFile As String
　　Dim fn As String
　　
　　Const 指定フォルダ = "C:\Temp\Test1\"
　　
　　For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
　　　　If Cells(i, 3).Value <> "" Then
　　　　　　fn = Cells(i, 3).Value 'これは単なる見かけです。見難くなるのを恐れて
　　　　　　TargetFile = Dir$(指定フォルダ & fn & ".xls?", vbNormal)
　　　　　　If TargetFile <> "" Then
　　　　　　　　ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), _
　　　　　　　　Address:=指定フォルダ & TargetFile
　　　　　　End If
　　　　End If
　　Next i
End Sub

'//

GooUserラック · Answer

チャント見たわけではありません
「Do」～「Loop」が、対応しない可能性があるので
「GoTo Nxt」は「Exit Do」の方が良いと思います。

マクロによるハイパーリンクの自動化

こんにちは。

追伸：

人様の作ったものの評価はしませんが、このコード、見た感じ、変だと思いましたが、こちらで作ってみました。

チャント見たわけではありません

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング