VBAでVBAを削除？

作業中のブックから一枚のシートを以下のSub 別ファイル保存()プロシージャで別のブックとして保存します。それはうまくいったのですが、この元になるシートには

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'途中略
End Sub

と

Private Sub Worksheet_Deactivate()
'途中略
End Sub

の二つのVBAが記述してあり、これまで一緒に別のブックに入ってしまいます。
これを防ぐにはどのようにすればよいのでしょうか？


Sub 別ファイル保存()
mypath = ThisWorkbook.Path
fn = Sheets("Declarations").Range("H15").Value & Format(Date, "yymmdd")
ffn = mypath & "\" & fn & ".xls"
Sheets("Declarations").Copy
ActiveWorkbook.SaveAs Filename:=ffn
ActiveWorkbook.Close
End Sub

No.1 ベストアンサー 回答者： o_w_nakazaki 回答日時： 2005/03/31 11:21

保存する前にこれを呼んでみてください。

シート名を変更して下さい。
ステップで動かすと動作しません。

Public Sub delete_module()
Dim del_module As Object
Dim i As Long

Set del_module = ThisWorkbook.VBProject.VBComponents.Item("Sheet1").CodeModule
If del_module.CountOfLines > 0 Then
For i = 1 To del_module.CountOfLines
del_module.DeleteLines 1
Next
End If

End Sub

この回答への補足

早速ありがとうございます。
以下のようにしましたが「インデックスが有効範囲にありません」と実行時エラーが出ます。
デバッグOKとすると
Set del_module = ThisWorkbook.VBProject.VBComponents.Item("Declarations").CodeModule
が黄色く反転します。
エクセル2000です。

Sub TEST別ファイル保存()
mypath = ThisWorkbook.Path
fn = Sheets("Declarations").Range("H15").Value & Format(Date, "yymmdd")
ffn = mypath & "\" & fn & ".xls"
Sheets("Declarations").Copy
Call delete_module
ActiveWorkbook.SaveAs Filename:=ffn
ActiveWorkbook.Close
End Sub

Public Sub delete_module()
Dim del_module As Object
Dim i As Long
Set del_module = ThisWorkbook.VBProject.VBComponents.Item("Declarations").CodeModule
If del_module.CountOfLines > 0 Then
For i = 1 To del_module.CountOfLines
del_module.DeleteLines 1
Next
End If
End Sub

補足日時：2005/03/31 11:41

この回答へのお礼

おかげさまでなんとか出来ました。

VBComponentsを教えていただきましたので、これを検索してやっとわかりました。

で、ThisWorkbook.ですと本体のVBAが削除されてまずいですよね？

Set del_module = ActiveWorkbook.VBProject.VBComponents.Item("Sheet1").CodeModule

でうまく行っています。
ありがとうございました。

お礼日時：2005/03/31 14:58

No.5 回答者： taocat 回答日時： 2005/04/03 23:10

こんばんは。

No4へのコメント読みました。
コードがアップされてないので何とも言えませんが
いつか気が向いた時にでも新しい質問としてコードをアップしてみてください。
また皆で解決しましょう。

この回答へのお礼

はい、ありがとうございます。
またよろしくお願いします。

お礼日時：2005/04/04 11:24

No.4 回答者： taocat 回答日時： 2005/04/02 11:51

No.2です。

解決してなによりです。

お礼のコメントにちょと気になるところがありましたので一言。

＞コピーして値と書式だけ貼り付けようとも考えましたが
＞画像がいくつかあったのでシートのコピー方式でやりたい

これですが、当方の回答にもある、
Sheets("Sh01").Cells.Copy　を使えば、
シート全選択になってますのでShapeも画像も全てコピーされます。

但し、CommandButton等のコントロールは出来ませんが。(^^;;;

以上です。

この回答へのお礼

わざわざありがとうございます。

> Sheets("Sh01").Cells.Copy　を使えば、
> シート全選択になってますのでShapeも画像も全てコピーされます。

わたしもそう思うのですが、どういうわけか出来ません。
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
を設定すると貼り付けるときにエラーになってしまいます。

お礼日時：2005/04/02 22:34

No.3 回答者： fly_moon 回答日時： 2005/03/31 14:35

Set del_module = ThisWorkbook.VBProject.VBComponents.Item("Declarations").CodeModule

の部分の"Declarations"はシート名ではないですか？
シートのオブジェクト名はSheet1とかSheet2とかだと思います。プロジェクトエクスプローラのシートオブジェクトの()の中の名前ではなくその左側の名前を指定すれば、うまくいくと思うのですが。

この回答へのお礼

> シートのオブジェクト名はSheet1とかSheet2とかだと思います。

はい、まさにそのとおりでした。
VBComponentsで検索してやっとわかりました。

で、No2さんへのお礼でも書きましたが、試行錯誤の結果なんとか完成しました。

ThisWorkbook.で本体のVBAが削除されてまずいですよね？

お礼日時：2005/03/31 14:50

No.2 回答者： taocat 回答日時： 2005/03/31 13:46

こんにちは。

発想を転換して、シートの内容だけコピーすればいいのでは？

コピーのシート名は、"Sh01" とした場合
----------------------------------------------

Sub 別ファイル保存()
　Dim MyPath, fn, ffn

　MyPath = ThisWorkbook.Path
　fn = Sheets("Sh01").Range("H15").Value & 　　　　Format(Date, "yymmdd")
　ffn = MyPath & "\" & fn & ".xls"

'=== ここから　＝＝＝＝＝＝＝＝

　Dim NewBook As Workbook

　Sheets("Sh01").Cells.Copy

　Set NewBook = Workbooks.Add

　With NewBook
　　.Sheets(1).Paste
　　.Sheets(1).Name = "Sh01"
　　.SaveAs Filename:=ffn
　　.Close
　End With

Application.CutCopyMode = False

End Sub
---------------------------------------------

以上です。

この回答へのお礼

ありがとうございます。
コピーして値と書式だけ貼り付けようとも考えましたが、画像がいくつかあったのでシートのコピー方式でやりたいのです。

試行錯誤の結果、シート名をSheet1にし、Thisworkbookでは本体のVBAが消えてしまったのでこれをActiveworkbookに変更してなんとか出来ました。

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

お礼日時：2005/03/31 14:47