EXCEL2000 VBA ハイパーリンクの有るセルを選択出来ないようする 実験（失敗）その２

EXCEL2000 VBA ハイパーリンクの有るセルを選択出来ないようする　実験（失敗）その２

http://telstar.blog.so-net.ne.jp/2012-10-17-1　　のつづき

ハイパーリンクの設定文字列に　[']を一文字目に付加し選択するとエラーダイアログを表示する（表示したくはないが）。
ハイパーリンクが不適切なので開く事は無い。
もう一度マクロを実行すると有効にできる。

 

Sub ハイパーリンクを有効無効()
'ハイパーリンクが設定されてるセルの値に「’」シングルクオーテーションを付加して
'無効にする。(エラーにする）警告ダイアログがでる
'有効にするには、「’」シングルクオーテーションを削除する
'
Dim HLcount As Long                                 'ハイパーリンクの個数
Dim Raddress As String     'ハイパーリンクのあるセルアドレス
Dim HL_address As String              'ハイパーリンク内容
Dim i As Long                                              'カウンター用


'選択シートに設定されているハイパーリンクの個数を調べる
    HLcount = ActiveSheet.Cells.Hyperlinks.Count
'ハイパーリンクが無ければ終了、
    If HLcount = 0 Then Exit Sub
'ハイパーリンクの文字列の最初の文字が[']か調べる

    If Left((ActiveSheet.Hyperlinks(1).Address), 1) = "'" Then GoTo 有効 Else GoTo 無効
無効:
'ハイパーリンクの値に「 ' 」を文字列の先頭つける
    For i = 1 To HLcount
        Raddress = ActiveSheet.Hyperlinks(i).Range.Address
        HL_address = "'" & ActiveSheet.Hyperlinks(i).Address
        ' [']を付加した文字列をハイパーリンクに設定
        ActiveSheet.Hyperlinks.Add Anchor:=Range(Raddress), Address:=HL_address
    Next i
    Exit Sub
有効:
'ハイパーリンクを調べる
    For i = 1 To HLcount
        Raddress = ActiveSheet.Hyperlinks(i).Range.Address
        ' 付加した[']を削除
        HL_address = Right(ActiveSheet.Hyperlinks(i).Address, Len(ActiveSheet.Hyperlinks(i).Address) - 1)
        ActiveSheet.Hyperlinks.Add Anchor:=Range(Raddress), Address:=HL_address
    Next i

End Sub

感想

まぁいいか～　←　子供みたいだねぇ　（小倉さん風）

追記

Sub ハイパーリンクを有効無効()
'ハイパーリンクが設定されてるセルの値に「’」シングルクオーテーションを付加して
'無効にする。(エラーにする）警告ダイアログがでる
'有効にするには、「’」シングルクオーテーションを削除する
'
Dim HLcount As Long          'ハイパーリンクの個数
Dim Raddress As String       'ハイパーリンクのあるセルアドレス
Dim HL_address As String   'ハイパーリンク内容
Dim i As Long                      'カウンター用
Dim mymesse As String       'メッセージ文字列

'選択シートに設定されているハイパーリンクの個数を調べる
    HLcount = ActiveSheet.Cells.Hyperlinks.Count
'ハイパーリンクが無ければ終了、
    If HLcount = 0 Then Exit Sub
'ハイパーリンクの文字列の最初の文字が[']か調べる
    If Left((ActiveSheet.Hyperlinks(1).Address), 1) = "'" Then GoTo 有効 Else GoTo 無効
   
無効:
'ハイパーリンクの値に「 ' 」を文字列の先頭つける
    For i = 1 To HLcount
        Raddress = ActiveSheet.Hyperlinks(i).Range.Address
        HL_address = "'" & ActiveSheet.Hyperlinks(i).Address
        ' [']を付加した文字列をハイパーリンクに設定
        ActiveSheet.Hyperlinks.Add Anchor:=Range(Raddress), Address:=HL_address
    Next i
        mymesse = "ハイパーリンクを不正にしました"
        MsgBox mymesse
    'ステータスバーに状態表示
        Application.StatusBar = mymesse
    Exit Sub
有効:
'ハイパーリンクを調べる
    For i = 1 To HLcount
        Raddress = ActiveSheet.Hyperlinks(i).Range.Address
        ' 付加した[']を削除
        HL_address = Right(ActiveSheet.Hyperlinks(i).Address, Len(ActiveSheet.Hyperlinks(i).Address) - 1)
        ActiveSheet.Hyperlinks.Add Anchor:=Range(Raddress), Address:=HL_address
    Next i
        mymesse = "ハイパーリンクを戻しました"
        MsgBox mymesse
        MsgBox mymesse
    'ステータスバーに状態表示
        Application.StatusBar = mymesse

End Sub

 

 

タグ：Excel2000 VBA ハイパーリンク