| |
いつもお世話になっております。
>過去ログを参照してください。
>http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=21998;id=excel
上記を参考にして作ったところおおむねうまくいきましたが、失敗することがあります。
〜プログラムの概要〜
シート（ Sheet1 ）にコマンドボタン（ cmd選択シート保存 ）が貼り付けられ、そのボタンを押すと、そのシートのみ新規ブックにコピーして保存するプログラムです。
コマンドボタンを押すと、標準モジュールの選択シート保存プロシージャを呼び出し、Sheet1を新規ブックにコピーし、コピー先シートに残っているコード（ Private Sub cmd選択シート保存_Click() ）とコマンドボタンを削除するもの。
＊うまくいくケース
コピー元のブックのVBAプロジェクトを一度開いた後に実行すると、コピー先のシートのコードがきれいに消されている。
（コードは消されているが、ファイルを開くときに、どういう訳かマクロを有効にするか否かのメッセージが出てきてしまう）
＊うまくいかないケース
コピー元のブックのVBAプロジェクトを一度も開かずに実行すると、コピー先のシートのコードが残ってしまう。（コードが消されない）
対処方法があればご教示ください。
コードは下記のとおりです。
〜Sheet1のイベントプロシージャ〜
Private Sub cmd選択シート保存_Click()
Module1.選択シート保存
End Sub
〜module1の選択シート保存プロシージャ〜
Sub 選択シート保存()
Dim ShName As String
ShName = ActiveSheet.Name
'アクティブシートを新規ブックにコピー
ActiveSheet.Copy
'コピー先のシートモジュールを削除
With ActiveWorkbook.VBProject.VBComponents.Item(2).CodeModule
.DeleteLines 1, .CountOfLines
End With
'コピー先シートのオブジェクトを削除
Dim cmdShape As Shape
For Each cmdShape In ActiveSheet.Shapes
'コマンドボタン
If Left(cmdShape.Name, 3) = "cmd" Then
cmdShape.Select
Selection.Delete
'テキストボックス
ElseIf Left(cmdShape.Name, 3) = "txt" Then
cmdShape.Select
Selection.Delete
'ラベル
ElseIf Left(cmdShape.Name, 3) = "lbl" Then
cmdShape.Select
Selection.Delete
'コンボボックス
ElseIf Left(cmdShape.Name, 3) = "cmb" Then
cmdShape.Select
Selection.Delete
End If
Next cmdShape
'保存するかどうかの確認
DlgAnswer = Application.Dialogs(xlDialogSaveAs).Show(ShName)
If DlgAnswer = True Then
ActiveWorkbook.Close
Else
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End If
End Sub
|
|
miyake
- 05/2/20(日) 22:29 -
