Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10986 / 76735 ←次へ | 前へ→

【71291】Re:Hypaerlinkをマクロで実行する方法
発言  hint  - 12/2/17(金) 20:04 -

引用なし
パスワード
   例えば、C4に
= IF(B4="","",HYPERLINK("#sheet2!"&CHAR(64+COLUMN(D$3) )&ROW(A4),・・・))
が入力されていて、同様な式が複数箇所にあるとすれば、
次のようなもので対応できるでしょう。

Sub Sample4()
  Dim fm As String
  Dim r As Range
  Dim p1 As Long, p2 As Long
  Dim myRow As Long, myColumn As Long, mySheet As String
  
  If TypeName(Selection) = "Range" Then
    Set r = Selection
    If r(1).HasFormula Then
      fm = r(1).Formula
      p1 = InStr(UCase(fm), "HYPERLINK")
      If p1 > 0 Then
        myRow = r.Row
        myColumn = r.Column + 1
        p2 = InStr(p1 + 11, fm, """")
        mySheet = Mid$(fm, p1 + 12, p2 - (p1 + 13))
        Application.Goto Worksheets(mySheet).Cells(myRow, myColumn), True
      End If
    End If
  End If
End Sub

あとは、HYPERLINKの第二引数に、
ジャンプ先を取り出せるように忍ばせておく手があるでしょう。
そうすれば、単にSelection.Value(に簡単な置換をしたもの)を使って
ジャンプすることができるでしょう。

9 hits

【71275】Hypaerlinkをマクロで実行する方法 hiros2048 12/2/17(金) 9:04 質問
【71276】Re:Hypaerlinkをマクロで実行する方法 hint 12/2/17(金) 9:23 発言
【71277】Re:Hypaerlinkをマクロで実行する方法 UO3 12/2/17(金) 10:04 発言
【71278】Re:Hypaerlinkをマクロで実行する方法 hint 12/2/17(金) 10:37 発言
【71279】Re:Hypaerlinkをマクロで実行する方法 UO3 12/2/17(金) 10:58 発言
【71280】Re:Hypaerlinkをマクロで実行する方法 hint 12/2/17(金) 11:10 発言
【71282】Re:Hypaerlinkをマクロで実行する方法 hiros2048 12/2/17(金) 11:17 質問
【71284】Re:Hypaerlinkをマクロで実行する方法 hint 12/2/17(金) 11:27 発言
【71285】Re:Hypaerlinkをマクロで実行する方法 UO3 12/2/17(金) 11:27 発言
【71281】Re:Hypaerlinkをマクロで実行する方法 UO3 12/2/17(金) 11:13 発言
【71283】Re:Hypaerlinkをマクロで実行する方法 UO3 12/2/17(金) 11:24 発言
【71286】Re:Hypaerlinkをマクロで実行する方法 hiros2048 12/2/17(金) 14:28 質問
【71288】Re:Hypaerlinkをマクロで実行する方法 hint 12/2/17(金) 17:06 発言
【71291】Re:Hypaerlinkをマクロで実行する方法 hint 12/2/17(金) 20:04 発言
【71292】Re:Hypaerlinkをマクロで実行する方法 hiros2048 12/2/17(金) 22:03 質問
【71295】Re:Hypaerlinkをマクロで実行する方法 hint 12/2/17(金) 22:56 発言
【71298】Re:Hypaerlinkをマクロで実行する方法 hiros2048 12/2/18(土) 8:43 お礼

10986 / 76735 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free