[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ハイパーリンク関数を関数じゃないハイパーリンクにしたい。』（北の事務員）
エクセルでサーバーにあるPDFをハイパーリンクで開くようにしていました。
PDFがたまってきたある日ハイパーリンク関数の事を知り、関数に書き直しました。
が、激重となってしまい非常に困っています。
なので、関数にしたハイパーリンクを関数ではないハイパーリンクに戻したいのです。
大した量ではないのですが、1,000ほどあり手作業でやるには…。
（コピーしておけば良かったと後悔しています）
何か方法はありますでしょうか？
よろしくお願いします。
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
なんとなくHYPERLINK関数は関係ない気がしますが・・・
関数にしても、どこかのセルにアドレスが入力されているのか、
関数の中にリテラル値として入力されているのかにもよって変わります。
=HYPERLINK(A1,"リンク")
=HYPERLINK("C:\TEST\ABC.PDF","リンク")
どっちでしょう？
あとハイパーリンクだと相対パスになってしまうので、パスの起点変更が必要かと https://mirai-digital.net/excel-hyperlink-not-open-file/
（稲葉） 2023/03/23(木) 17:31:56
＞ =HYPERLINK("C:\TEST\ABC.PDF","リンク")
こちらの方にしています。
目的のPDFは自分のPC内ではないのでサーバー経由でのファイルを指定しています。
謎様がおっしゃっているように「関数」をやめたいのです。
右クリック → リンク → リンクの挿入 からファイルを選んでいくやつです。
どなたかやり方が分かる方、よろしくお願い致します。
（北の事務員） 2023/03/24(金) 09:03:14
＞謎様がおっしゃっているように「関数」をやめたいのです。 ＞右クリック → リンク → リンクの挿入 からファイルを選んでいくやつです。
わかってるけど、コーディング簡単にしたかったから聞いたんだけど、 どっちでも対応できるようにしたから大丈夫です。
１）以下のコードを対象のブックの標準モジュールに貼り付けてください。 参考URL https://atmarkit.itmedia.co.jp/ait/articles/1402/13/news040_3.html
２）コードのうち変換したいシート名を入れてくださいのところを変更してください ３）バックアップ用に、ブックをコピーしておいてください ４）リンク変換実行を実行すると変換が完了します
'ここからコピー
Option Explicit
'///////////////////////////////////
'変換したいシート名を入れてください。
Const SheetName As String = "Sheet1"
' ↑↑↑
'///////////////////////////////////
Sub リンク変換実行()
'ハイパーリンクの起点を「￥」に設定して、絶対パスとして保存させる
With ThisWorkbook.BuiltinDocumentProperties("Hyperlink base")
If .Value <> "" Then
.Value = "\"
End If
End With
Debug.Print サブリンク変換(Sheets(SheetName))
MsgBox "変換完了しました"
End Sub
Function サブリンク変換(ws As Worksheet) As Long
Dim fRng As Range, r As Range
Dim f As String
Dim m As Object, sm As Object
Dim adr As String
Dim title As String
Dim cnt As Long
'正規表現の初期設定
Static reg As Object
If reg Is Nothing Then
Set reg = CreateObject("VBScript.RegEXP")
reg.Global = True
reg.Pattern = "HYPERLINK\((.+?)(,(.+?)|)\)"
End If
'シートの保護が解除されているかチェック
If ws.ProtectContents = True Then
MsgBox ws.Name & "シートの保護を解除してから実行してください"
Exit Function
End If
'ジャンプ機能で数式セルだけピックアップ
On Error Resume Next
Set fRng = ws.Cells.SpecialCells(xlCellTypeFormulas, 23)
On Error GoTo 0
If fRng Is Nothing Then Exit Function
cnt = 0
'ピックアップした数式セルをループ処理
For Each r In fRng
'数式にHYPERLINKが含まれていれば変換開始
f = r.Formula
If f Like "*HYPERLINK*" Then
Set m = reg.Execute(f)
Set sm = m(0).submatches
'第1引数がセルアドレスなら、セルに記載されているアドレスを取得
'リテラル値ならその値を取得
If Evaluate("ISREF(" & sm(0) & ")") = True Then
adr = Replace(Evaluate(sm(0)), """", "")
Else
adr = Replace(sm(0), """", "")
End If
'第2引数（表示させる文字）が設定されていれば、その文字を取得
'そうでなければ、アドレスを表示文字に設定
If sm(2) <> "" Then
title = Replace(sm(2), """", "")
Else
title = adr
End If
'ハイパーリンクに変換
r.ClearContents
ws.Hyperlinks.Add _
Anchor:=r, _
Address:=adr, _
TextToDisplay:=title
cnt = cnt + 1
End If
Next r
サブリンク変換 = cnt
End Function
'ここまでコピー
（稲葉） 2023/03/24(金) 10:04:01
週明けに結果報告させて頂きます！
（北の事務員） 2023/03/24(金) 21:34:35
稲葉様！大変すみません！！
そして、ありがとうございます！
早速やってみました。（エラーもなくサクッと！！！）
が、リンク先の指定の名前を指定させる組み合わせだったため
リンク先の名前ではなく、セル番号の名前のPDF指定になってしまいました…。
=HYPERLINK($C$2&I4&".pdf","●")
↑実際の関数です。(関数はB列に貼っています。C2が指定フォルダ。I列にファイル名。）
これだと「=HYPERLINK(A1,"リンク")」の方だということですね、見当違いな返答ですみませんでした。
週明け・年度末で仕事が立て込んでおり、ちゃんと見れていないのですが
ヒントはいただけたので、時間のある時にチャレンジしてみます！
また、ダメだったときにはお世話になります^^;
（北の事務員） 2023/03/27(月) 15:10:56
組み合わせまで頭回ってなかったのと、難しく考えすぎてた・・・ 第一引数がセル参照と文字列の組み合わせ 第二引数がセル参照を含む場合 どちらもEvaluateで計算させてあげればいいだけだったので、Function以下差し替えお願いします。
Function サブリンク変換(ws As Worksheet) As Long
Dim fRng As Range, r As Range
Dim f As String
Dim m As Object, sm As Object
Dim adr As String
Dim title As String
Dim cnt As Long
'正規表現の初期設定
Static reg As Object
If reg Is Nothing Then
Set reg = CreateObject("VBScript.RegEXP")
reg.Global = True
reg.Pattern = "HYPERLINK\((.+?)(,(.+?)|)\)"
End If
'シートの保護が解除されているかチェック
If ws.ProtectContents = True Then
MsgBox ws.Name & "シートの保護を解除してから実行してください"
Exit Function
End If
'ジャンプ機能で数式セルだけピックアップ
On Error Resume Next
Set fRng = ws.Cells.SpecialCells(xlCellTypeFormulas, 23)
On Error GoTo 0
If fRng Is Nothing Then Exit Function
cnt = 0
'ピックアップした数式セルをループ処理
For Each r In fRng
'数式にHYPERLINKが含まれていれば変換開始
f = r.Formula
If f Like "*HYPERLINK*" Then
Set m = reg.Execute(f)
Set sm = m(0).submatches
'第一引数がなんであれ、Evaluateで対応できた（2023/3/27）
adr = Replace(Evaluate(sm(0)), """", "")
'第2引数（表示させる文字）が設定されていれば、その文字を取得
'そうでなければ、アドレスを表示文字に設定
'第2引数もアドレスである場合を考慮すると、Evaluateで計算させたほうがよさそう（2023/3/27）
If sm(2) <> "" Then
title = Replace(Evaluate(sm(2)), """", "")
Else
title = adr
End If
'ハイパーリンクに変換
r.ClearContents
ws.Hyperlinks.Add _
Anchor:=r, _
Address:=adr, _
TextToDisplay:=title
cnt = cnt + 1
End If
Next r
サブリンク変換 = cnt
End Function
（稲葉） 2023/03/27(月) 15:36:54
1ヵ月近く悩んでたのに^^;;;
このエクセルシートもお陰様で軽くなりました！
本当にありがとうございます！！！！！
（北の事務員） 2023/03/27(月) 16:14:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.