エクセルのマクロで

質問

いつもお世話になっております。

エクセル2000ですが、

別のファイルを開いて、そのファイル上で
マクロを実行させるときは、

orkbooks.Open Filename:= _
　　"◆◆◆.xls"

'以下実行させるマクロの記述
'（例）◆◆◆上に、データをペーストとか

としていますが、

◆◆◆を別の作業で開いたままですと、
当然この上記マクロが動いてくれなくなってしまいます。

そこで、
1：◆◆◆が開いているかどうか判定する。
2：開いていれば◆◆◆をアクティブにしてマクロ実行
3：開いていなければ、◆◆◆を開いてマクロ実行

　とするためには、
どのように記述したらよろしいでしょうか？

わかりづらければ、補足しますので、
よろしくお願いします。

回答No.4

kazuhiko5681 · ベストアンサー

おはようございます。ゆっくり考えたところ大きなミスに気付きました。
私のマクロは、絶対に動きません。
そもそもFor each Nextは、この場合立ち上がっているファイルすべてに動作してしまいます。４個のファイルが立ち上がっていたとして説明させていただきます。
エクセルは、ファイルを複数開いた場合、開いた順番に番号が自動的に振られます。私が最初に書いたコードを実行すると、まず最初に開かれたブックの名前を取得してもしＡというブックだったらＡをAｃtivateし、違っていたらＡを開きにいきます。これを４回繰り返してしまうのです。ですから、あなた様のおっしゃられたような警告メッセージが出てしまったのです。
結論から申し上げますと、Ａファイルが開いているかどうかを確認するためには、あなた様が書かれたようにまずFor each　NextでまずＡファイルが開いているかどうか確認し、If文で書くしか方法はありません。このような基本的なミスを２度もしてしまい、誠に申し訳ございませんでした。穴があったら入りたい心境です。深くお詫び申し上げます。

後、コピー・ペーストの方法ですが、あなた様が書かれた方法もありますが、私の書いた方法の方が行数が少なくてすむかと思います。また、本の知識の受け売りですが、あなた様の書かれた方法は、クリップボードを経由してペーストされるのですが、私の書いた方法はクリップボードを経由せずにペーストされるため、メモリーの消費量が少なくて済むそうです。

他の気がついた点につきましては、＃３で書かせていただきました。こんな私でよろしければ、また解らないことがありましたらお知らせ下さい。次回はこのようなことがないように、注意を払い一緒にに考えていきたいと思います。

１日も早くあなた様のシステムが無事完成されますことを心からお祈り申し上げます。

お礼

kazuhiko5681さん

本当にご丁寧なご回答・ご説明ありがとうございました。
ほぼ#2の方の回答で解決していたのですが、
より一層の理解を深めることができました。
コピペの方法も教えていただきありがとうございました。

また何かありましたら、よろしくお願いします。

回答No.3

kazuhiko5681

お返事が遅くなり申し訳ございませんでした。変な動きをしたのは私のマクロの記述ミスです。申し訳ございませんでした。
下記にあなた様がおやりになろうとしているサンプルマクロを記述しておきます。

sub

dim myBook as workbook

'カーソルを砂時計に
Application.Cursor = xlWait
'画面を更新しない
Application.ScreenUpdating = False

If myBook.Name = "◆◆◆.xls" Then
Workbooks("◆◆◆.xls").Activate
exit sub
Else
Workbooks.Open Filename:="◆◆◆.xls"
End If
Next
前回は、ブックが開いている時に、このるーぷから抜けなかったために◆◆◆.xlsは2重に開かれます云々という警告が出てしまったのです。

workbooks("ブック名.xls").worksheets("シート名").range("E1:I1).copy _
destination:=workbooks("ブック名.xls").worksheets("シート名").range("E300)
これを書くだけでＥ１からＩ１のデータをＥ３００からＩ３００にコピー・ペーストできます。
Application.CutCopyMode = False

workbooks("ブック名.xls").close SaveChanges:=true
何も保存して閉じなくてもこの１行で保存してそのブックを閉じることができます。もし保存しないで終了する時は、SaveChanges:=Falseと書けばいいのです。

workbooks("ブック名).Activate
workbooks("ブック名").worksheets("シート名").Range("A6").Select
Ａ６を選択する場合、そのブックが選択されていなければエラーが出てしまいます。このように書けば、どんな場合でもエラーを出さずに選択することができます。
Application.ScreenUpdating = True
Application.Cursor = xlDefault

End Sub

これであなた様のやりたいことが正常に動作すると思います。

回答No.2

taisuke555

#1さんの補足
dim myBook as workbook

open_flg = 0:'オープンされている場合　1:に変更
for each mybook in workbooks
if mybook.name = "◆◆◆.xls" then
open_flg = 1
exit for
end if
next

if ( open_flg = 0 ) then 'openされていない
workbooks("◆◆◆.xls").activate
else 'openされている
workbooks.open filename:="◆◆◆.xls"
end sub

としないと、ブックを３個以上開いているとき、
◆◆◆.xls以外のブックが２個出てきてしまい、OPEN を２度してしまい
エラーになるのだと思います。

お礼

ご回答ありがとうございました。
お蔭様で、解決となりました。
大変参考になりました。

補足

ありがとうございます。
やはり、2コ目のIFに対するEnd　Ifが無いといわれ、
最後にEnd　Ifを足し、
かつ
workbooks.open filename:="◆◆◆.xls"
と
workbooks("◆◆◆.xls").activate
を入れ替えて、
どうやらうまくいったようです。

結局、
Dim myBook As Workbook

open_flg = 0: 'オープンされている場合　1:に変更
For Each myBook In Workbooks
If myBook.Name = "◆◆◆.xls" Then
open_flg = 1
Exit For
End If
Next

If (open_flg = 0) Then 'openされていない
Workbooks.Open Filename:="◆◆◆.xls"
Else 'openされている

Workbooks("◆◆◆.xls").Activate
End If

という形になりました。

回答No.1

kazuhiko5681

はじめまして。

sub test

dim myBook as workbook

for each mybook in workbooks
if mybook.name = "◆◆◆.xls" then
workbooks("◆◆◆.xls").activate
else
workbooks.open filename:="◆◆◆.xls"
end sub

実行するマクロの前にこのマクロを書けばよろしいかと思います。

もし、不具合がありましたらご遠慮なくお知らせ下さい。あなた様のおやりになりたいことが実現するまで私でよろしければご一緒に考えて生きたいと思います。

補足

kazuhiko5681さん、
心強いお言葉ありがとうございます。

最初に確認したいのですが、
Sub　test
End　Sub
はいらないですよね？

早速やってみましたが・・・
まず、
End　IF　が無いとエラーがで、
それを追加したら、
NEXTが無いといわれたので、
workbooks.open filename:="◆◆◆.xls"
の後に、
End　If
Next
と入れました。

すると、
◆◆◆.xlsは2重に開かれます云々
という警告がでました。
「はい」で実行したところ、
実行はされていました。

2重に～にならないようにするにはどうすればいいでしょうか？

現状マクロは、

Sub
'
'カーソルを砂時計に
Application.Cursor = xlWait
'画面を更新しない
Application.ScreenUpdating = False
'
Dim myBook As Workbook

For Each myBook In Workbooks
If myBook.Name = "◆◆◆.xls" Then
Workbooks("◆◆◆.xls").Activate
Else
Workbooks.Open Filename:="◆◆◆.xls"
End If
Next

'
Range("E1").Select
Range("E1:I1").Select
Selection.Copy
Range("E300").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

ActiveWorkbook.Save
ActiveWindow.Close
Range("A6").Select

Application.ScreenUpdating = True
Application.Cursor = xlDefault
End Sub

　こんな感じです。
ご助言いただけますでしょうか？