EXCEL2000 VBA ハイパーリンク一覧を作成する 実験

EXCEL2000 VBA  ハイパーリンク一覧を作成する　実験

 

Sub シートのハイパーリンク一覧()
'
Dim newS As Worksheet           '
Dim aSname As String              '選択しているシート名
Dim newSname As String          '新しく作るシート名
Dim i As Long                       '汎用
Dim msg As Variant                'vbyesyno の値
 
 '一覧を作成するシートをすぐ後に作る（シート名は選択シート＋”HL一覧”）
    aSname = ActiveSheet.Name      'シート名
    'シート名の確認
        msg = MsgBox("アクティブシート名は　" & aSname & "です。" & vbCrLf & vbCrLf & "このシートのハイパーリンク一覧を作成しますか？", vbYesNo)
            Select Case msg
                Case vbYes
                    GoTo yes
                Case vbNo
                    MsgBox "処理を終了します。シートを選択し直してから実行してください"
                    Exit Sub
            End Select
yes:
 '同一のシート名があるか調べる（同一のシート名があったらシートセル全体の値を消す）
        For i = 1 To ActiveWorkbook.Sheets.Count
            If ActiveWorkbook.Sheets(i).Name = aSname & "HL一覧" Then ActiveWorkbook.Sheets(i).Cells.Delete: GoTo make
        Next i
    '新しくシートを作成
        Worksheets.Add(After:=Worksheets(ActiveSheet.Name)).Name = aSname & "HL一覧"
    '
   
'シートのハイパーリンク一覧を作成
make:
    newSname = Worksheets(aSname).Name & "HL一覧"
        For i = 1 To Worksheets(aSname).Cells.Hyperlinks.Count
            Worksheets(newSname).Cells(i, 1) = Worksheets(aSname).Hyperlinks(i).Range.Address  'アドレス　$A$1
            Worksheets(newSname).Cells(i, 2) = Range(Worksheets(aSname).Hyperlinks(i).Range.Address).Value 'セルの値
            Worksheets(newSname).Cells(i, 3) = Worksheets(aSname).Hyperlinks(i).Address     'ハイパーリンクの値
    Next i
'作成したハイパーリンク一覧をセレクトしセル幅を整える
        Worksheets(newSname).Cells.EntireColumn.AutoFit

End Sub

 Worksheets("Excel関数").Hyperlinks.Delete    はできる

Worksheets("Excel関数").Hyperlinks=False      はできない ？

 

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