• ベストアンサー

複数ブックの最後のブックだけ処理できない

開いている複数ブックに対して「簡単な処理を行い、保存して閉じる」 というマクロを走らせたいのですが、 最後のブックのみ処理できずにマクロが終了してしまいます。 例えば、3ブック開いていたら3ブック目が、 4ブック開いていたら4ブックめが、処理できずに開いたままの状態です。 Dim Wb As Workbook For Each Wb In Workbooks 簡単な処理内容 ActiveWorkbook.Close SaveChanges:=True Next どのように改善すれば良いのでしょうか？

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

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.3

　　Dim Wb As Workbook 　　For Each Wb In Workbooks 　　　　If Wb.Name <> ThisWorkbook.Name Then 　　　　　　Wb.Activate 　　　　　　'簡単な処理 　　　　　　'・・・・・・ 　　　　　　Wb.Close SaveChanges:=True 　　　　End If 　　Next 　　'Excel自体を終了 　　Application.Quit

ampm2007
質問者

お礼

出来ました！ 有難うございました！

その他の回答 (2)

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.2

もしくは Dim wb As Workbook For Each wb In Workbooks 　　If wb.Name <> ThisWorkbook.Name Then wb.Close SaveChanges:=True Next ThisWorkbook.Close SaveChanges:=True かな

ampm2007
質問者

お礼

Wbで取得したブックをアクティブにしてやることで、 思い通りの動作になりました。 Dim Wb As Workbook For Each Wb In Workbooks target = Wb.Name Workbooks(target).Activate If Wb.Name <> ThisWorkbook.Name Then 簡単な処理内容 ActiveWorkbook.Close SaveChanges:=True End If Next ヒントを頂けて助かりました。

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

　　For Each Wb In Workbooks 　　　　'簡単な処理内容 　　　　Wb.Close SaveChanges:=True 　　Next では

ampm2007
質問者

補足

マクロの記述を「PERSONAL.XLSB」に記述して実行しているのですが、 ご教示頂いたWb.Closeで試すと「PERSONAL.XLSB」が閉じてしまいます。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • Activeブック以外の開いているブックを閉じたい

    複数のbookが開いている状態で、 Activebook以外のworkbookを閉じたいです。 book名、book数は一定ではありません。 こんなことをしてみたのですが動かないです。 何かよい方法はないでしょうか。 Dim hbook As Object 名前 = ActiveWorkbook.Name For Each hbook In Workbooks If hbook.Name <> 名前 Then Workbooks(hbook & ".xls").Close ' False End If Next

  • 複数シートをブックにするマクロを応用して。。

    1ブック内にyymmdd（日付）シートが多数あり、それを月別yymmごとブックを作成するマクロです。 これは以前、回答して頂いた「n-jun」さんの構文です（n-junさん、重宝しています、感謝！） Private Sub CommandButton1_Click() Dim myDic As Object Dim wb1 As Workbook Dim wb As Workbook Dim ws As Worksheet Dim sh As Worksheet Dim myKey Set myDic = CreateObject("Scripting.Dictionary") Set wb1 = ThisWorkbook Application.ScreenUpdating = False For Each sh In wb1.Worksheets myDic(Left(sh.Name, 4) & "_") = Empty Next For Each myKey In myDic.keys For Each sh In wb1.Worksheets If InStr(sh.Name, Left(myKey, 4)) > 0 Then If wb Is Nothing Then wb1.Worksheets(sh.Name).Copy Set wb = ActiveWorkbook Else wb1.Worksheets(sh.Name).Copy after:=wb.Sheets(wb.Sheets.Count) End If End If Next Application.DisplayAlerts = False wb.SaveAs Filename:="C:\仕事\月別" & "\" & Left(myKey, 4) & ".xls" wb.Close Set wb = Nothing Application.DisplayAlerts = True Next Application.ScreenUpdating = True Set myDic = Nothing Worksheets("main").Activate MsgBox "出力完了" End Sub 実は、これをフォルダ内のブックの場合は？ として応用ができないか悩んでいます。 つまり、フォルダ内にyymmddブックが多数あり、 これを月別yymmとして、それぞれまとめたいのです。 Set wb1 = ThisWorkbookの箇所が、 フォルダ内のブック指定になると思うのですが、 下記コードでどうなんでしょうか？動きません。 myfdr = "C:\仕事\月別" fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 Set wb1 = Workbooks.Open(myfdr & "\" & fname) 変更箇所、アドバイス頂ければ助かります。お願いします

  • エクセルのブックを閉じるマクロについて

    エクセルのブックＡとブックＢが開いている状態で、 ブックＡのボタンに登録して実行すると、ブックＡのみ閉じる、 というマクロを作りました。（下部にコードを記載します） このマクロは、２つのブックが開いていると正常に稼働するのですが、 ブックが１つしかない場合、実行時エラーが出てしまいます。 （ブックＡのみ開いた状態でこのボタンを押してもエラーなく閉じたい） 実行時エラーが出ないようにするにはどうすれば良いか、 おわかりの方がいらっしゃいましたら教えて下さい。 どうぞよろしくお願い致します。 Sub このブックのみ閉じる() Dim wa As String wa = "ほかに無い" Dim wb As Workbook For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name Then wa = "ほかにあるよ" End If Next If wa = "ほかに無い" Then Application.DisplayAlerts = False Application.Quit '終了予定 End If Range("D2").Select Selection.ClearContents ThisWorkbook.Close SaveChanges:=False End Sub

  • Excelのブックを閉じる

    お世話になります。 Excel処理について質問です。 今、サーバで常にマクロが動き続けているExcelファイル(ファイルAとします)があります。 今回はそのファイルを閉じ、マクロにてシートの更新をしたのち、また開きなおしてマクロを実行させたいです。 方法としては、 1.C#から閉じて更新して開く処理を行う。 2.別のブックにファイルAを閉じる処理を行うマクロを仕込んでおき、 C#からはそのファイルを開くだけ。 が考えられると思っています。 どちらの方法でも良いので、コードの例を書いていただけないでしょうか。 ちなみに、自分の現状のコードは以下です。 (アラート非表示) for each wb in Workbooks if wb.Name <> ThisWorkbook.Name then wb.Close SaveChanges:=false end if next Application ThisWorkbook.Close SaveChanges:=false これでは、異なるブックのExcelファイルであっても、ウィンドウが分かれ てしまっていては、削除の対象になりません。 どなたか、宜しくお願いします。

  • 個人用マクロブックの有無

    エクセルVBAで現在ユーザーが使っているパソコンに個人用マクロブックが存在するかどうかを取得する方法を考えました。 まず、開いているBOOKを総当りして、エクセル2003までなら　PERSONAL.XLS、2007からは"PERSONAL.XLSM　がひらいているかどうかを調べる方法。 Sub test1() Dim wb As Workbook For Each wb In Workbooks If wb.Name Like "PERSONAL.XLS*" Then MsgBox "個人用マクロブックがあります。" Exit Sub End If Next MsgBox "個人用マクロブックはありません。" End Sub 最初から個人用マクロブックがあるものとして変数に入れ、エラーになったら無いと判断する方法。 Sub test2() Dim wb As Workbook Dim v As String v = IIf(Val(Application.Version) > 11, "PERSONAL.XLSM", "PERSONAL.XLS") On Error Resume Next Set wb = Workbooks(v) On Error GoTo 0 MsgBox "個人用マクロブックが" & IIf(wb Is Nothing, "ありません。", "あります。") End Sub でも、自分の端末はまだ2000で、しかも個人用マクロブックがあるので、ちゃんと判定できているのかどうか自信がありません。 これで正しいのでしょうか？ また、test1とtest2ではどちらをつかえばいいのでしょうか？ あるいは、もっと簡単なやりかたはないのでしょうか？

  • vba, 複数ブックの同一セルに同一写真を挿入

    エクセルVBAの初心者です。使っているのはExcel2007です。 同じフォルダの中にある連番の複数のエクセルファイルに同じ操作を繰り返すマクロを作っています。まず、複数ブックの同一セルに同じ内容の文字列を挿入することはどこかで見つけました。 Sub 複数Book同一セルに同一文字列入力() Dim fName As Variant Dim i As Long Dim WB As Workbook fName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xlsx", MultiSelect:=True) If IsArray(fName) Then For i = LBound(fName) To UBound(fName) Set WB = Workbooks.Open(fName(i)) WB.Worksheets(1).Range("A1").Value = "テスト" WB.Close SaveChanges:=True Next End If End Sub また、選択したセルに同じフォルダの中にある写真を挿入するマクロもどこかで拝見しました。 Sub AddPictureSampLinkPaste() Dim myFileName As String Dim myShape As Shape myFileName = ActiveWorkbook.Path & "\Koala.jpg" '--(1) 選択位置に画像ファイルを挿入し、変数myShapeに格納 Set myShape = ActiveSheet.Shapes.AddPicture( _ Filename:=myFileName, _ LinkToFile:=True, _ SaveWithDocument:=False, _ Left:=Selection.Left, _ Top:=Selection.Top, _ Width:=0, _ Height:=0) '--(2) 挿入した画像に対して元画像と同じ高さ・幅にする With myShape .ScaleHeight 1, msoTrue '数字は写真の高さの倍数 .ScaleWidth 1, msoTrue '数字は写真の幅の倍数 End With End Sub ここまではテストで問題なかったので、この二つのマクロを一つにまとめて、同じフォルダにある連番のエクセルブックの同一セルに同一写真を挿入するマクロを作ろうと下記のようにアレンジしましたが、なぜか写真はマクロを記入したブックのアクティブセルに連番のブックの数だけの写真が重なるように貼り付けられるだけで、標的のブックには写真が挿入できません。 Sub 複数Bookの同じ位置に同一写真挿入() Dim fName As Variant Dim i As Long Dim WB As Workbook Dim myFileName As String Dim myShape As Shape fName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xlsx", MultiSelect:=True) myFileName = ActiveWorkbook.Path & "\Koala.jpg" If IsArray(fName) Then For i = LBound(fName) To UBound(fName) Set WB = Workbooks.Open(fName(i)) Worksheets("Sheet1").Activate '--(1) 選択位置に画像ファイルを挿入し、変数myShapeに格納 Set myShape = ActiveSheet.Shapes.AddPicture( _ Filename:=myFileName, _ LinkToFile:=True, _ SaveWithDocument:=False, _ Left:=Selection.Left, _ Top:=Selection.Top, _ Width:=0, _ Height:=0) '--(2) 挿入した画像に対して元画像と同じ高さ・幅にする With myShape .ScaleHeight 1, msoTrue .ScaleWidth 1, msoTrue End With WB.Close SaveChanges:=True Next End If End Sub 本当にどこが間違っているか分からず、ここで質問いたします。初心者で分からないところばかりなので、どなたかやさしく教えていただけませんか？よろしくお願いいたします。

  • エクセル　マクロのこの意味教えて

    初心者で済みませんが 下記のマクロの意味を行ごとに教えてください。 Dim bk As Workbook Set bk = ActiveWorkbook Dim st As Worksheet For Each st In bk.Sheets Workbooks.Add st.Copy Before:=ActiveWorkbook.Sheets(1) ActiveWorkbook.SaveAs path & st.Name & ".xls" ActiveWorkbook.Close Next 以上です

  • Excelマクロ　複数のシート検索・選択して新しいブックにコピー

    何方か、回答をお願いします。 下記のマクロは、任意のフォルダに有る全てのxlsファイルのシート名が”Data”のみ 新しいブックにコピー（シート名は、元のファイル名に変更）をしていくマクロですが、 条件が下記のように変更になりました。 シート名は、DataとAppend*（*は数字で1～99）（Appendの数は毎回ばらばらでAppend シートその物が無い場合も有ります。）を選択して新しいブックにコピー （元のシート名の前に元のファイル名を足して新しいシート名は”ファイル名Append2” こんな感じにしたいです。）したいのですがどの様なマクロを書けば良いのか教えて 下さい。 Sub test-xls版() Dim myPName As String Dim myKAKUCHOSI As String Dim myPATHNAME As String Dim myLName As String Dim wb As Workbook Dim wb_New As Workbook Dim N As Byte Dim ws As Worksheet Dim myFN As String myPName = Application.GetOpenFilename("測定データ（*.xls;*.csv）,*.xls;*.csv") If myPName = "False" Then Exit Sub Application.ScreenUpdating = False Set wb_New = Workbooks.Add myKAKUCHOSI = Right(myPName, 4) myPATHNAME = CurDir myLName = Dir("") N = Len(myLName) myFN = Left(myLName, N - 4) Do While myLName <> "" Workbooks.OpenText Filename:=myPATHNAME & "\" & myLName, DataType:=xlDelimited, Tab:=True, Comma:=True, Space:=True N = Len(myLName) myFN = Left(myLName, N - 4) Sheets("Data").Select 'csvの場合無し Set wb = ActiveWorkbook wb.ActiveSheet.Copy after:=wb_New.Sheets(wb_New.Worksheets.Count) Worksheets("Data").Name = myFN 'csvの場合無し wb.Close savechanges:=False myLName = Dir() Loop Application.ScreenUpdating = True Exit Sub

  • もしも新規Excelファイルを開いてる場合は閉じる

    Excel2003です・ ユーザーが新規Excelファイル（book1)かテスト用ファイルを開いている場合は閉じる処理を考えております。 Option Explicit Dim ws As Workbook, flag As Boolean Private Sub Workbook_Open() For Each ws In Workbooks If ws.Name = "Book1" Then flag = True Next ws If flag = True Then Workbooks("Book1.xls").Close 　 Else 　 End IF For Each ws In Workbooks If ws.Name = "テスト用.xls" Then flag = True Next ws If flag = True Then Workbooks("テスト用.xls").Close 　 Else 　 End IF End Sub このコードだとBook1を開いているのに、Trueで拾ってくれません。 ws.Name = "Book1.xls"にしても同じです。 どこかおかしい部分があるのでしょうか？

  • ブックの選択について

    ブックの選択について 以下のように、マクロのあるブック意外のブックを開いて からマクロのあるブックを選択しようとしてもできません。 具体的には一番下の Workbooks(thisBook).Select が正常に動きません。 なぜでしょうか？ Dim myFName As String Dim macrobook As Object Dim thisBook As Workbook Set thisBook = ThisWorkbook myPath = ActiveWorkbook.Path ChDir myPath myFName = Dir("*S*.xls") Workbooks.Open Filename:=myFName Workbooks(myFName).Activate Worksheets(1).Select Workbooks(thisBook).Select

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する