ハイパーリンクの自動設定マクロ

質問

セルＣ５～Ｃ１０００には「N1309068」の様なN○○○○○○○（半角英数字）の文字が入力されています。

コマンドボタンを押すとセルＣ５～Ｃ１０００の範囲が自動でハイパーリンクが設定される様にしたいです。

リンクさせるファイルはデスクトップの「改善シート（リンク用）」のフォルダの中にある「N1309068 KAIZEN」のエクセルファイルです。

セルＣ５～Ｃ１０００の範囲に記入した数字を、リンク先のフォルダの中にあるエクセルファイルN○○○○○○○ KAIZEN（半角英数字）の○○○○○○○の数字と一緒のファイルにリンクさせるようにするＶＢＡは、どの様に組めば宜しいでしょうか？

回答No.1

keithin · ベストアンサー

＞「N1309068 KAIZEN」のエクセルファイルです。

ファイルに向けてハイパーリンクを設定するときは、ファイルの「拡張子」まで正しく指定しなければいけません。
N1309068 KAIZEN.xlsxなのかxlsなのかxlsmなのか、実際をキチンと調べ正しくご自分でマクロに反映してください。

手順：
シートに配置したアクティブＸコントロールのコマンドボタンのマクロに下記を準備する
private sub CommandButton1_Click()
　dim myPath as string
　dim h as range
　dim WSH as variant

　set wsh = createobject("Wscript.Shell")
　mypath = wsh.specialfolders("Desktop") & "\"
　activesheet.hyperlinks.delete
　for each h in range("C5:C1000").specialcells(xlcelltypeconstants, xltextvalues)
　if h like "N*" then
　　activesheet.hyperlinks.add anchor:=h, address:=mypath & h.value & " KAIZEN.xlsx"　’拡張子を正しく設定する事
　end if
　next
　set wsh = nothing
end sub

＞コマンドボタンを押すと

エクセルには「フォーム」と「アクティブＸコントロール（コントロールツールボックス）」の２種類のコマンドボタンが用意されています。どちらを使っているのかに応じて、正しいマクロの書き振りが違います。
ご相談投稿では、どちらを使っているのか（使いたいのか）正しく情報提供するよう心掛けて下さい。次回以降のご参考に。

お礼

この度は回答して頂きありがとうございました！！
非常に助かりました。

補足

この度は回答して頂き、誠にありがとうございます。非常に助かりました。
拡張子は「ｘｌｓ」ファイルです。今後、相談する場合は詳しく書きたいと思います。
今回のＶＢＡを実際に作動させると、Ｃ５～Ｃ１０００の範囲はハイパーリンクになりました。

アクティブＸコントロール（コントロールツールボックス）をクリックし、実行するとＣ５～Ｃ１０００の文字の配置が縦が「標準」で横が「下詰め」となり、N○○○○○○○（半角英数字）の記入している文字の下に引いていた罫線が消えてしまいます。

なので、文字の下の罫線が消えず、文字の配置が縦も横も「中央揃え」にするＶＢＡと言うのも出来るのでしょうか？

回答No.3

WindFaller

こんにちは。

書式とか問題までは手を出す気にはなれませんが、ちょっと口をはさみます。

ネットワークドライブ「E:\フォルダX\5係\改善提案\改善シート\改善シート（リンク用）」
#1のmypath に、そのアドレスを入れればいいだけじゃないのですか？
#1さんの書き方は、質問の内容上、やむを得ず、そう書かざるを得なかったからでしょうけれど。

私は、ただ、締められないで、質問が長続きしているようなので、気になりました。
この質問のようなファイル名だけの場合は、わざわざハイパーリンクづけするようなスタイルはしません。もともと、拡張子が同じExcel系なら、そのままテキスト値だけで、以下のコードで開けます。

ハイパーリンクにした後のものには使えませんが、ハイパーリンク自体を削除すれば、いろんな書式の問題も解決するはずです。ファイル名もフォルダー名も正しく入力さえしていれば、ダブルクリックで開けます。
実際は、分っていないと、どこかでつまずきます。

'//該当するシートモジュール
Private Const mPATH = "Your Folder" 'ご自身の指定のフォルダー（モジュールの先頭に書く)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　Cancel = True
　If Target.Value = "" Then Exit Sub
　If StrComp(Right(Target.Value, 4), ".xls", 1) <> 0 Then Exit Sub
　If Target.Hyperlinks.Count > 0 Then Exit Sub
　If Dir(mPATH & Target.Value) = "" Then MsgBox "ファイルが見つかりません。", 48: Exit Sub
　Workbooks.Open mPATH & Target.Value
End Sub
'//

お礼

この度は補足事項に回答して頂きありがとうございました。
色々と勉強になりました。

回答No.2

keithin

では回答したマクロの
　activesheet.hyperlinks.delete
の一行を削除してください。

それでもダメなら、今のブックからＣ列をコピー、「まっさらのエクセルブック」のＣ列に形式を選んで貼り付けの「値」で貼り付け、罫線、書式設定、コマンドボタンを「新しく」設定し、上述の一文を除いたマクロを実行し状況を確認してください。

お礼

この度は回答して頂きありがとうございました！！
非常に助かりました。

補足

補足して頂きありがとうございます。
最後にもう一つ聞きたいのですがデスクトップで無く、ネットワークドライブ「E:\フォルダX\5係\改善提案\改善シート\改善シート（リンク用）」のフォルダの中にあるN○○○○○○○（半角英数字）のxlsファイルをハイパーリンクする場合はどの様にすれば宜しいのでしょうか？