- ベストアンサー
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
- みんなの回答 (2)
- 専門家の回答
関連するQ&A
- もしも新規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"にしても同じです。 どこかおかしい部分があるのでしょうか?
- ベストアンサー
- その他MS Office製品
- Excelのブック間の串刺し計算について
Excelのブック間の串刺し計算について VBA超初心者です。同じフォルダ内にファイルがいくつかあり、同じ形式で、sheet1のB4のセルに計があったとして、それをブック間で串刺し集計したいのですが、うまくいきません。どこが悪いのかもわからず、困り果ててます。ご指導お願いします。 Sub BookShuukei() Dim FileName As String Dim Total As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean FileName = Dir("*.xls") Application.ScreenUpdating = False Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Total = Total + Workbooks(FileName).Sheets(1).Range("B4").Value If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.ScreenUpdating = True MsgBox (Total) End Sub
- 締切済み
- オフィス系ソフト
- 複数のファイルのsheet1だけをまとめるには
sub UsedRangeをOffsetする() Dim rng先 As Range Dim PathMacrobook As String Dim Name元book As String Dim 元Book As Workbook Dim 元Sheet As Worksheet Set rng先 = Workbooks("BOOKALL.xls").Worksheets(1).Range("A2") PathMacrobook = ThisWorkbook.Path & "\" Name元book = Dir(PathMacrobook & "*.xls") Do While Not Name元book = "" If Name元book = ThisWorkbook.Name Then ElseIf Name元book = "BOOKALL.xls" Then Else Set 元Book = Workbooks.Open(PathMacrobook & Name元book) For Each 元Sheet In 元Book.Worksheets With 元Sheet.UsedRange .Offset(1).Copy rng先 Set rng先 = rng先.Offset(.Rows.Count - 1, 0) End With Next 元Book.Close False End If Name元book = Dir() Loop End Sub このコードではフォルダにあるブックのすべてのシートをBOOKALLのシート1に 上書きコピーしてしまう事がわかりました。 やりたい事 オープンするブックのsheet1だけを、.end(xlup)を使って一覧にしたいです。。 どの様にしたらよいでしょうか?
- ベストアンサー
- オフィス系ソフト
- エクセルのブックを閉じるマクロについて
エクセルのブックAとブックBが開いている状態で、 ブックAのボタンに登録して実行すると、ブックAのみ閉じる、 というマクロを作りました。(下部にコードを記載します) このマクロは、2つのブックが開いていると正常に稼働するのですが、 ブックが1つしかない場合、実行時エラーが出てしまいます。 (ブックAのみ開いた状態でこのボタンを押してもエラーなく閉じたい) 実行時エラーが出ないようにするにはどうすれば良いか、 おわかりの方がいらっしゃいましたら教えて下さい。 どうぞよろしくお願い致します。 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(エクセル)
- ExcelVBAで特定のブックをcloseしたい
よろしくお願いします。Excel2000ですが、2002,2003,2007でも利用できることを前提に考えています。 複数のExcelブックを開いているとき、特定のファイル名のブックを閉じる方法を考えています。 2通り考えたのですが、いずれもだめでした。デバッグ機能でステップインしながら確認したのですが、エラーにもならず、closeメソッドを通過していました。 以下のVBAはなにか誤りがあるのでしょうか? (その1) For i = 1 To Workbooks.Count If Left(Workbooks(i).Name, 2) = "v3" Then msw = Workbooks(i).Name If msw <> "V3main.xls" Then Workbooks(msw).Close End If End If Next (その2) For Each wb In Workbooks If Left(wb.Name, 2) = "v3" Then MsgBox (wb.Name) If wb.Name <> "V3main.xls" Then With wb .Saved = True .Close End With End If End If Next wb
- ベストアンサー
- Visual Basic
- Excel 2007 Windows7での不具合
下記のExcel 2007 VBAマクロを Windows XP で組んでいましたが、 Windows 7 に乗り換えたとたん、強制終了してしまいます。 Workbooks.Openのアドレスは、Windows 7用に書き換えました。 何方かご教授願います。 Private Sub CommandButton63_Click() Application.ScreenUpdating = False Dim wb As Workbook wbn1 = ActiveWorkbook.Name For Each wb In Workbooks If wb.Name = wbn1 Then Workbooks.Open "D:\ユーザー\PC18\Documents\※※※※\※※※※.xls" ActiveWindow.WindowState = xlMaximized Workbooks(wbn1).Save Application.DisplayAlerts = False Workbooks(wbn1).Close Else: Application.ScreenUpdating = False End If Next Application.ScreenUpdating = True End Sub
- 締切済み
- Visual Basic
- Excel VBAで確認なしで上書き保存
起動中のBookでファイル名が Data.xlsのものを閉じたいと思いますが、 上書き確認メッセージを出さないように oExcel.DisplayAlerts = False を設定すると エラーになります。 CreateObject で作成した場合は、DisplayAlerts が使えるようですが、 すでに起動済みのBookを確認なしで上書き保存するにはどうしたらいい のでしょうか? Sub UnloadFile() Dim myBook2 As Workbook Dim myBook1 As Workbook For Each myBook2 In Workbooks If myBook2.Name = "Data.xls" Then Set myBook1 = myBook2 myBook1.SaveAs myBook1.FullName myBook1.Close End If Next myBook2 Set myBook1 = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- ブックの選択について
ブックの選択について 以下のように、マクロのあるブック意外のブックを開いて からマクロのあるブックを選択しようとしてもできません。 具体的には一番下の 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
- ベストアンサー
- Visual Basic
- 複数ブックの最後のブックだけ処理できない
開いている複数ブックに対して「簡単な処理を行い、保存して閉じる」 というマクロを走らせたいのですが、 最後のブックのみ処理できずにマクロが終了してしまいます。 例えば、3ブック開いていたら3ブック目が、 4ブック開いていたら4ブックめが、処理できずに開いたままの状態です。 Dim Wb As Workbook For Each Wb In Workbooks 簡単な処理内容 ActiveWorkbook.Close SaveChanges:=True Next どのように改善すれば良いのでしょうか?
- ベストアンサー
- Visual Basic
- エクセルVBAで別BOOKに「名前の定義」のCopy
前からあったエクセルのファイルのどこかが壊れたらしく、ときどき作業中に突然エラーとなってエクセル自体が落ちてしまうので、BOOKの複製では意味がないと考え、同じ内容のものを別BOOKに再作成するマクロを以下のとおり作ってみました。(新規作成のBOOKにこのマクロを貼ります) これで、VBAのモジュールを除き、再作成できたのですが、どういうわけか「名前の定義」を行なったセル範囲の一部が反映されません。 調べてみると、他のセルから参照されていない「名前の定義」がすっぽり抜け落ちるようにも思えるのですが、この理解であっているでしょうか? 他のセルから参照していなくとも、マクロで参照しているので抜け落ちるのは困ります。 どうすれば、すべての「名前の定義」が再作成されるでしょうか? Sub Book_Copy() Dim fn As String Dim wb1 As Workbook, wb2 As Workbook Dim ans As Integer, i As Integer Dim nm As Name Dim sh As Worksheet fn = Application.GetOpenFilename("エクセル ファイル (*.xls), *.xls") If fn = "False" Then Exit Sub Application.EnableEvents = False Set wb1 = Workbooks.Open(Filename:=fn, UpdateLinks:=1) Set wb2 = ThisWorkbook ans = MsgBox(wb1.Name & "を " & wb2.Name & " へCopyしますか?", vbYesNo + vbQuestion) If ans = vbNo Then Exit Sub For Each nm In wb2.Names nm.Delete Next nm For Each sh In wb1.Worksheets sh.Cells.Copy i = i + 1 If wb2.Worksheets.Count = i Then wb2.Worksheets.Add After:=Worksheets(i) Application.DisplayAlerts = False wb2.Activate wb2.Worksheets(i).Activate wb2.Worksheets(i).Cells.Select ActiveSheet.Paste wb2.Worksheets(i).Name = sh.Name Application.DisplayAlerts = True Application.CutCopyMode = False End If Next sh wb1.Close (False) Application.EnableEvents = True ActiveWorkbook.ChangeLink Name:=fn, NewName:=wb2.Name, Type:=xlExcelLinks Set wb1 = Nothing Set wb2 = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
お礼
有難うございます。 記述がおかしかったですね。 助かりました。