みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

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

解決済みの質問

エクセルVBAで、ある特定な場所にあるブックが開いていたら閉じたい

こちらでお世話になった者です。その節はありがとうございました。
http://okwave.jp/qa3972230.html

他のブックが開いているとエラーになるので、フォームのブックが開いていたら、
マクロの最初に閉じてしまいたいと思います。

dbase.xls
formフォルダ
 001.xls
 002.xls
 003.xls

のようなフォルダ構造になっていて、001~003.xlsは入力フォームです。
dbase.xlsを開いて、マクロを貼り付けたボタンをクリックすると、すべてのフォームの
データがdbase.xlsに取り込まれます。

↓のような感じで、最初にメッセージが表示されるようにしたのですが、
自分以外の、formフォルダにあるブックが開いていたらそれをすべて閉じる
方法を教えていただけますか。

Sub data_torikomi()
MsgBox ("開いている他のエクセルブックをすべて閉じてください")
Dim Fn As String
Dim myPath As String
Dim dbBkSh As Worksheet
Dim i As Long
Set dbBkSh = Workbooks("dbase.xls").Worksheets("一覧表")
myPath = ThisWorkbook.Path & "\"
Fn = Dir(myPath & "form\*.xls")
i = 1
  ……

投稿日時 - 2008-04-30 19:16:19

QNo.3987988

困ってます

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

こんばんは。

ちょっと考えてみました。

Sub data_torikomi()
Dim wb As Workbook
Dim Fn As String
Dim myPath As String
Dim dbBkSh As Worksheet
Dim i As Long
For Each wb In Workbooks
 If wb.Name <> ThisWorkbook.Name And _
 InStr(1, wb.FullName, "form\", 1) > 0 Then 'formを検索
   wb.Close False '閉じる
 End If
Next wb
myPath = ThisWorkbook.Path & "\"
Set dbBkSh = Workbooks("dbase.xls").Worksheets("一覧表")
Fn = Dir(myPath & "form\*.xls")
i = 1
'・
'・
'・
End Sub

なんとなく、良く分からないのは、ThisWorkbook の存在は、とういう立場にあるのだろうかって思います。このままだと、アドインスタイルです。ただ、アドインは、Workbooks には掛からないです。

ところで、おまけですが、開いている他のExcelブックをすべて閉じるのは、このようにします。メッセージは、しばらく開いていますが、自動的に閉じます。つまり、このブックだけにしますが、PEROSNAL.XLS は、残します。


'開いているブックを、本体だけ残して閉じてしまうマクロ
Dim ret As Integer
ret = CreateObject("WScript.Shell").Popup("開いている他のエクセルブックをすべて閉じます", 3, "CloseMessage", 1)
If ret = 2 Then Exit Sub
For Each wb In Workbooks
 If (Not StrConv(wb.Name, vbUpperCase) Like "PERSONAL.XLS") _
  And (wb.Name <> ThisWorkbook.Name) _
  And (wb.Name Like "Book#") Then
  wb.Close False
 End If
Next wb

投稿日時 - 2008-05-01 00:21:45

お礼

いろいろと教えていただきまして、ありがとうございます。
上に書いていただいたコードできれいに目的を達成することができました。

私自身アドインがなんなのかよくわからないのですが、ThisWorkbookは、dbase.xlsです。
上書き保存したいファイルは、dbase.xlsのルートの中にあるformフォルダにあります。
ですからWorkbooksに掛からなくても問題ないということでしょうか。

どうもありがとうございましたm(_ _)m。

投稿日時 - 2008-05-01 17:47:31

ANo.2

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

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

回答(3)

ANo.3

こんばんは。

>私自身アドインがなんなのかよくわからないのですが、ThisWorkbookは、dbase.xlsです。

まあ、アドインにすることはないですけれども、dbase.xls と違うブックから操作するのかと思いました。

そうすると、
Set dbBkSh = Workbooks("dbase.xls").Worksheets("一覧表")

どちらでも同じことですが、ここの部分は、
Set dbBkSh = ThisWorkbook.Worksheets("一覧表")
で済みますね。

投稿日時 - 2008-05-01 19:49:01

お礼

ご回答ありがとうございます!

そうすると、ファイル名が変わってもこのマクロを動かすことができるようになり、大変便利になりました!

ありがとうございました。

投稿日時 - 2008-05-02 13:46:12

ANo.1

こんなところでどうでしょう。
参考URLのコードを参考にさせていただきました。
フォルダー名は目的のものに変更してください。
また、マクロは dbase.xls 内に記述してください。
Sub test()
Dim WBK As Workbook
Dim strOwnBook As String

strOwnBook = ThisWorkbook.Name
For Each WBK In Workbooks
If WBK.Name <> strOwnBook Then
If WBK.Path = "C:\Documents and Settings\?????\My Documents" Then
Call WBK.Close(savechanges:=False)
End If
End If
Next WBK
End Sub

参考URL:http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_010_020.html

投稿日時 - 2008-04-30 21:21:50

お礼

コメントありがとうございます。
参考になりました。
今回の場合、フォームを配布してデータベースを回収するという使い方になりますので、あまりパスにこだわらない方が使い勝手が良さそうに感じました。

どうもありがとうございましたm(_ _)m
またよろしくお願いします。

投稿日時 - 2008-05-01 18:22:24

あなたにオススメの質問