[[20050630202158]]　『フォルダー内のファイルのシート名取得』（高次）　ページの最後に飛ぶ

『フォルダー内のファイルのシート名取得』（高次）

 フォルダー内のすべてのファイルのシート名をファイルを開かずに
 取得用ファイルのシートに一覧表を作ることはできないでしょうか
 たくさんありすぎて困っております。ご教授お願いいたします。

 >ファイルを開かずに取得用ファイルのシートに一覧表を作ることはできないでしょうか
 なぜ開かずになんですか? 
 普通に開いてシート名を取得すればいいと思いますけど。　(wizik)

 たくさんありますので、(＠_＠;)　（高次）

 量は関係ないでしょ。 開いた方が速いし。ファイルサイズが大きいとか？
  (INA)

 ファイルが重くて、非常に遅いもので（高次）

 どのくらいですか？
 基準がないと速度の検討はできません。
  (INA)

 10メガがごろごろあります。ファイルを開いて、シート名取得ファイルに
 シート名を取得していくのは可能なのでしょうか過去ログを検索したのですが
 同一シートに目次と作成して、取得するのはあったのですが、シート名取得ファイルに
 ファイル内のシート名を取得していきたいのですが(~_~;)（高次）

 どこに結果を出力するかは、ブックやシートの指定を変更するだけですよ。
  (INA)

   Sub Sample()
 Dim ws As Worksheet
 Dim i As Long
 Dim wsName As String: wsName = "目次"

 With ActiveWorkbook

    'シート追加
    Set ws = .Sheets.Add(before:=Worksheets(1))

    On Error GoTo ErrTrap
        ws.Name = wsName 'シート名の設定
    On Error GoTo 0

    'シート名取得
     For i = 1 To .Sheets.Count
         ws.Cells(i + 1, 1).Value = .Sheets(i).Name
     Next

        ws.Range("A1").Value = "シート名"
        ws.Columns(1).AutoFit
        MsgBox wsName & "シートを作成しました", , "目次作成"

    Exit Sub 'マクロ終了
 '================================-

ErrTrap: '重複シート処理

    If vbYes = MsgBox(wsName & "シートは既にあります。削除して作り直してもいいですか？" _
               , vbYesNo + vbQuestion) Then
         Application.DisplayAlerts = False
             .Sheets(wsName).Delete 'シート削除
         Application.DisplayAlerts = True
    Else
        i = i + 1
        wsName = "目次_" & i 'シート名に連番付与
    End If

    Resume

 End With
 End Sub
 同時に開いているシート名取得ファイルを何処に入れたらいいのでしょうか(>_<)
 目次シートはひとつの作成になるのですが、目次シートにファイルのシート名 
 を１シートに表示させたいのですが
（高次）

 こんなのですか？

 Sub Sample() 
 Dim myObj As Object
 Dim myFileName As String
 Dim myDir As String
 Dim mySheet As Worksheet
 Dim wb As Workbook

 Application.ScreenUpdating = False

 With ThisWorkbook.ActiveSheet

    Set myObj = CreateObject("Shell.Application"). _
                BrowseForFolder(0, "フォルダを選択してください", 0)

    If myObj Is Nothing Then Exit Sub
    myDir = myObj.Items.Item.Path & "\"
    myFileName = Dir(myDir & "*.xls")

        Do
            Set wb = Workbooks.Open(myDir & myFileName)

            For Each mySheet In wb.Worksheets
                .Cells(65536, 1).End(xlUp).Offset(1).Value = myFileName
                .Cells(65536, 2).End(xlUp).Offset(1).Value = mySheet.Name
            Next mySheet

            wb.Close False
            myFileName = Dir()

        Loop Until myFileName = vbNullString

    .Range("A1").Value = "ファイル名"
    .Range("B1").Value = "シート名"
    .Columns("A:B").AutoFit

 Application.ScreenUpdating = True
 End With

 End Sub

  (INA)

 鳥肌でました。すごいです。マクロは何でもできるのですね。
 それを使いこなす。INAさんはもっとすごいです。ありがとうございました。
 しかし、凄い＼(^o^)／　感激です。（高次）

横から失礼します。

マクロを含むブックが存在することを考えて
↓で挟んだほうがいいかと・・・。

  Application.EnableEvents = False

  Application.EnableEvents = True
(MARBIN)

 すべて、マクロがあるブックですが、シート名は取得されています・・・・・。
 （高次）

 説明不足でした。
 ThisWorkbookモジュールに
 Private Sub Workbook_Open()
 などのマクロがあれば実行されてしまいます。

 標準モジュールの
 Sub Auto_open()
 は実行されません。
 (MARBIN)

 可能性があるかもしれないので、何処に

  Application.EnableEvents = False

  Application.EnableEvents = True

 を入れたらいいのでしょうか、難しすぎて、(>_<)　（高次）

 画面再描画停止、再開の前後当りでいいかと思います。

 Application.ScreenUpdating = False '画面再描画停止
 Application.EnableEvents = False 'イベントの禁止
 ’処理
 Application.EnableEvents = True 'イベントの再開
 Application.ScreenUpdating = True '画面再描画再開

 (MARBIN)

 MARBINさん　ありがとうございました。これで、安心です。
 しかし、凄いですね。INAさんも、MARBINさんも　＼(^o^)／
 （高次）

コメント返信：

[ 一覧(最新更新順) ]

[[20050630202158]] 『フォルダー内のファイルのシート名取得』（高次） ページの最後に飛ぶ

[[20050630202158]]　『フォルダー内のファイルのシート名取得』（高次）　ページの最後に飛ぶ