[[tipsやちょっとしたスクリプト]]
 
 
  'このスクリプトはパブリックドメイン またはMITライセンスの何れかでライセンス
  'されます。
  
  Sub ListSheets()
   Dim r As Integer
   r = 0
   For Each s In Worksheets
     ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(r), Address:="", _
     SubAddress:="'" + s.Name + "'!A1", TextToDisplay:=s.Name
     r = r + 1
   Next s
  End Sub
  
  Sub ListFilesAndSheets()
  Dim bb As Workbook
  
    Set bb = ActiveWorkbook
    Worksheets(1).Select
    Dim ss(999) As String
    f = 1
    r = 1
     
    Do While Cells(f, 1).Value <> ""
       fn = Cells(f, 1).Value
     Workbooks.Open Filename:=fn, UpdateLinks:=False, ReadOnly:=True
       ns = Worksheets.Count
       
       i = 0
       For Each s In Worksheets
        i = i + 1
        ss(i) = s.Name
       Next s
     ActiveWorkbook.Close SaveChanges:=False
      bb.Activate
      Worksheets(2).Select
      Cells(r, 1).Value = fn
      r = r + 1
      For i = 1 To ns
         ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 2), Address:=fn, _
     SubAddress:="'" + ss(i) + "'!A1", TextToDisplay:=ss(i)
         r = r + 1
      Next
      
      Worksheets(1).Select
      
       f = f + 1
    Loop
  End Sub

トップ   差分 バックアップ リロード   一覧 単語検索 最終更新   ヘルプ   最終更新のRSS