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
Last-modified: 2013-07-16 (火) 00:49:45 (3944d)