こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルVBAの質問 開いているもう一つのブックのシート名をすべて取得する方法

おはようございます。
現在マクロを実行しているブックのシート名を下のようなコードで取得していますが、これを
開いているもうひとつのブックのシート名を
マクロ実行しているシート“しーと1”のJ3セル以降に並べる

というように変更したいのですが、下のコードを少し変更して
対応できるでしょうか?教えていただけたら助かります。

Sub シート名()
Dim i As Integer
Dim mySheetCnt As Integer
Dim mySheetNam As String
Application.ScreenUpdating = False
Columns("J:J").Select
Selection.ClearContents
Range("J2").Select
ActiveCell.FormulaR1C1 = "項目名"


mySheetCnt = ThisWorkbook.Sheets.Count

For i = 2 To mySheetCnt
mySheetNam = Sheets(i).Name
Sheets("しーと1").Cells(i, 10) = mySheetNam
Next i
Application.ScreenUpdating = True
MsgBox "シート名更新しました。"
End Sub

投稿日時 - 2008-05-03 05:57:52

QNo.3993898

すぐに回答ほしいです

質問者が選んだベストアンサー

再度の登場、onlyromです。

>いただいたコードを自分で直せず申し訳ありません。

いえ、いえ、別にどうってことありませんよ。
考え過ぎましたね。(^^;;;

>調べる対象は「もうひとつのブック」限定に書出したい


なら、先の回答にブック名をチェックするコードを入れるだけでいいのですが、
今度は、For Eachで。

'------------------------------------------------
Sub Test555()
 Dim myBook As Workbook
 Dim mySheet As Worksheet
 Dim LastRow As Long

 Application.ScreenUpdating = False

 ThisWorkbook.Activate
 Sheets("しーと1").Select

 Columns("J:J").ClearContents
 Range("J2").Value = "シート名"

 For Each myBook In Workbooks
   If myBook.Name <> ThisWorkbook.Name Then
     For Each mySheet In myBook.Worksheets
       LastRow = Cells(Rows.Count, "J").End(xlUp).Row
       Cells(LastRow + 1, "J").Value = mySheet.Name
     Next mySheet
   End If
 Next myBook

 Application.ScreenUpdating = True
 MsgBox "該当ブックのシート名を表示しました"
End Sub
'-----------------------------------------------


上記は、マクロのブックと他に1つブックが開いている場合です。
もし、他に複数のブックが開いていて、その中のどれか、という場合は、
そのどれかを決めてやらなければできません。

他に複数ブックが開いていてその中の、"売上.xls" というブックを対象にしたい場合は

  If myBook.Name <> ThisWorkbook.Name Then
これを
  If myBook.Name = "売上.xls" Then
とします。


それからマクロの書いてあるブックがアクティブで、かつ、シート1がアクティブな状態で
実行する場合は、下記2行はいりません。

 ThisWorkbook.Activate
 Sheets("しーと1").Select

また、常に、ブック名、シート名をRangeオブジェクトの前に付加する場合もいりません。

以上。
 

投稿日時 - 2008-05-03 12:33:13

お礼

どうもありがとうございました。勉強になりました。二つのブックということを操作しようとすのは、思った以上のことでした。又是非宜しくお願いします。

投稿日時 - 2008-05-03 17:12:55

ANo.4

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

こんにちは。

ご質問者のreprogress様は、マクロは、かなりお分かりになるようですね。

>調べる対象は「もうひとつのブック」限定

やはり確実なのは、全部出すことですが、それを、#2のお礼で書かれている「もうひとつのブック」というのを限定するというのは、思っているよりも難しいのです。

通常は、元のコードの
mySheetCnt = ThisWorkbook.Sheets.Count
 を、
mySheetCnt = ActiveWorkbook.Sheets.Count
 として、
ActiveWorkbook.Sheets(i).Name

として、人間が選択したほうが早いです。

ただし、
For i = 1 To mySheetCnt 'i = 1
mySheetNam = Sheets(i).Name
Sheets("しーと1").Cells(i + 2 , 10) = mySheetNam ' i+2(3行目から)
Next i
としたほうがよいです。

「もうひとつのブック」というのは、言葉では、単数なのですが、Excel VBAのプログラミングになれた人は、本能的に、その言葉を、必ずしも、「合計2ブック」としてコードを書くわけではありません。見えないブックも、いくつか立ち上がっていることがあります。また、足りないこともあります。

こういうことは、余計だと思うかもしれませんが、なるべく問題が起こらないような形の許容範囲でマクロを考えます。

私の場合、「もうひとつのブック」を、見えているもので、立ち上げた順序が、自ブック以外で一番早いものという限定をしました。
なお、ActiveWorkbook がどちらでも、自ブック以外のシート名(ワークシート名だけではありません)を同じように書き出します。

Worksheet とSheet の区別があります。

----------------------------------------
Sub Macro1()
  Dim wb As Workbook
  Dim tWb As Workbook
  Dim i As Integer
  'もうひとつのブックを探す
  For Each wb In Workbooks
    If wb.Name <> ThisWorkbook.Name _
      And wb.Windows(1).Visible = True Then
      Set tWb = wb
      Exit For
    End If
  Next wb
  If tWb Is Nothing Then
   MsgBox "もうひとつのブックがありません。", 48
   Exit Sub
  End If
  Application.ScreenUpdating = False
  With ThisWorkbook.Worksheets("しーと1")
    .Columns(10).ClearContents
    .Range("J2").Value = "*項目名*"
    For i = 1 To tWb.Sheets.Count
      .Cells(i + 2, 10).Value = tWb.Sheets(i).Name
    Next i
  End With
  Application.ScreenUpdating = True
  Set tWb = Nothing
  MsgBox "シート名更新しました。", 64
End Sub

投稿日時 - 2008-05-03 11:46:11

お礼

Wendy02さんありがとうございます。
>「もうひとつのブック」というのを限定するというのは、思っているよりも難しいのです。

知らなかったです。コードばっちりでした。Wendy02さんの回答はいつも参考にさせていただいています。今回最初の方からも解決の答えをいただきましたので、次点にさせていただくこと、申し訳ありません。また是非宜しくお願いします。

投稿日時 - 2008-05-03 17:09:56

ANo.2

どうせなら、ThisWorkbookも含め開いているブックの全シート名を表示する方がいいような。。。

ということで、開いている全てのブックの全シート名を、ThisWorkbookの"しーと1"のJ列、K列・・・に表示。
またそれぞれの列の1行目には、ブック名を表示。

'-------------------------------------------------
Sub Test()
 Dim B As Integer
 Dim S As Integer
 Dim BookCnt As Integer
 Dim SheetCnt As Integer

 Application.ScreenUpdating = False

 ThisWorkbook.Activate
 Sheets("しーと1").Select

 For B = 1 To Workbooks.Count
   SheetCnt = 0
   BookCnt = BookCnt + 1
   Columns(BookCnt + 9).ClearContents
   Cells(1, BookCnt + 9).Value = Workbooks(B).Name
   Cells(2, BookCnt + 9).Value = "シート名"

   For S = 1 To Workbooks(B).Sheets.Count
     SheetCnt = SheetCnt + 1
     Cells(SheetCnt + 2, BookCnt + 9).Value = Workbooks(B).Sheets(S).Name
   Next S
 Next B

 Application.ScreenUpdating = True
 MsgBox "開いているブックの全シート名を表示しました"
End Sub
'-----------------------------------------------------
 

●For B=1 to workbooks.Count
の代わりに
●For Each B In Workbooks
とする方法を使うとコードが若干短くなります。
以上。
 

投稿日時 - 2008-05-03 10:05:17

お礼

ありがとうございました。せっかく書いていただいて恐縮ですが、調べる対象は「もうひとつのブック」限定に書出したいと考えています。いただいたコードを自分で直せず申し訳ありません。

投稿日時 - 2008-05-03 10:13:29

ANo.1

Sub シート名()
Dim i As Integer
Dim mySheetCnt As Integer

'シート名を配列に格納するために、配列で変数を定義

Dim mySheetNam(256) As String


Application.ScreenUpdating = False



mySheetCnt = ThisWorkbook.Sheets.Count

'このループでシート名の取得は完了

For i = 2 To mySheetCnt
mySheetNam(i) = Sheets(i).Name
Next i




'別のブックに記述するという要件なので、別ブックをアクティブに
Windows("Book2.xls").Activate


Columns("J:J").Select
Selection.ClearContents
Range("J1").Select
ActiveCell.Value = "項目名"

'このループで取得したシート名をセルに代入

For n = 2 To mySheetCnt
Sheets("しーと1").Cells(n, 10).Value = mySheetNam(n)
Next n


Application.ScreenUpdating = True
MsgBox "シート名更新しました。"
End Sub
===
上記で良いでしょうか?
excel2003では正常に動きました。

投稿日時 - 2008-05-03 07:08:57

あなたにオススメの質問