エクセルVBAを保存時に消したい

質問

はじめて質問させて頂きます。
エクセルのVBAを覚え始めたばかりの物ですが、
見積書式を作成し、見積番号をVBAでファイルOPEN時に自動挿入し
名前を付けて保存する時はその見積番号が保存する時にファイル名に
なるようにVBAを作成しました。
見積番号の呼び出し方法は
指定フォルダにある（.xls）ファイルの数+1としています。

ここで質問なのですが現状だと保存したファイルにはVBAが存在するので
そのファイルの修正をする時マクロの実行の有無を聞いてきます。
実行しないを選べば見積番号は変わらないのですが
間違えて実行してしまうとそのファイルの見積番号が変わってしまいます。。
回避方法として知り合いからアドインファイルにすれば？と言われて
保存形式をxlaにしたのですがエラーが出てしまいました＞＜
Const FPath = "C:\指示書"
Sub Auto_Open()
'xlsファイル検索
With Application.FileSearch
.NewSearch
.Filename = "*.xls"
.FileType = msoFileTypeAllFiles
.LookIn = FPath
.SearchSubFolders = False
.Execute

Cells(1, 21).Value = .FoundFiles.Count + 1
Cells(1, 21).NumberFormat = "0000"
End With
End Sub

したから4行目のCells(1, 21).Value = .FoundFiles.Count + 1
でエラーが出てしまうようで。。原因がわかりません。
何が原因なのでしょうか？＞＜

回答No.10

onlyrom · ベストアンサー

またまたまたまた登場、onlyromです。

（条件と処理内容）
（１）フォルダーは　”C:\指示\記入済”
（２）保存ボタンで新見積書を保存する
　　　但し、マクロコードとボタンを削除したものを保存する
（３）新見積書の保存後はブック、エクセルともに終了する

なお、質問者のコードを書き換えた部分がありますので以下のコードは、そのままコピペして下さい。
フォルダー名は適宜変更のこと。

'--- Module1 ----変数FPathは、Publicで宣言しないといけません

Public Const FPath = "C:\指示\記入済"

Sub Auto_Open()
　With Application.FileSearch
　　.NewSearch
　　.Filename = "*.xls"
　　.FileType = msoFileTypeAllFiles
　　.LookIn = FPath
　　.SearchSubFolders = False
　　.Execute

　　Cells(1, 21).Value = .FoundFiles.Count + 1
　　Cells(1, 21).NumberFormat = "0000"
　End With
End Sub

'----- Module2 -----ボタンに登録されたマクロ-----

Sub ファイルに名前を付けて保存()
　Dim 既定ファイル名 As String
　Dim 保存ファイル名 As Variant

既定ファイル名 = FPath & "\" & Range("T1") & Format(Range("U1"), "0000") & Range("B1") & ".xls"

保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名)

　　If 保存ファイル名 = False Then
　　　　MsgBox "保存は中止されました"
　　　　Exit Sub
　　End If

　ActiveWorkbook.SaveCopyAs 保存ファイル名

　Dim NewBook As Workbook
　Set NewBook = Workbooks.Open(保存ファイル名)

　Dim myVBA As Object
　For Each myVBA In NewBook.VBProject.VBComponents
　　　With myVBA
　　　　If .Type = 100 Then
　　　　　.CodeModule.DeleteLines 1, .CodeModule.CountOfLines
　　　　Else
　　　　　Application.VBE.activeVBProject.VBComponents.Remove myVBA
　　　　End If
　　　End With
　Next myVBA

　NewBook.ActiveSheet.Shapes(1).Delete
　NewBook.Close True

'●●●
　Set NewBook = Workbooks.Open(保存ファイル名)
　NewBook.Close True
'●●●

'ブックとエクセル終了
　Application.Quit
　ThisWorkbook.Close False

End Sub
'----------------------------------------------------

今度は、SaveAsではなく、SaveCopyAsメソッドを使用しなければいけません。
●●●の間の２行は、お呪い？ということで。。
これ新しい発見でした。（感謝）

■新しい補足の記述についての注意
家で新しい見積を作成するときは、会社のパソコンから”C:￥指示”をまるごと家のパソコンにも入れておかないと拙いですよね。
要するに、会社も家も”C:￥指示￥記入済”の中のファイルの数は常に同じものにしとかないといけないということです。
もちろん、家では会社で作成した見積書のメンテだけするというのであれば別ですが。　

コードの説明がいるときはお気軽にお尋ねください。
以上。

お礼

無事出来上がりました！本当にありがとうございました♪

回答No.13

Wendy02

こんばんは。

#6/#8 の回答者です。

#12 の回答の補足の
>ほむほむ。。スッキリしました！

コマンドボタンから、まったく別の方法の考えで、私も作りましたが、せっかくのonlyrom さんのおつくりになったものを、後から汚すつもりもありませんので、そのままにしておきます。考え方は違いますが、結果的には大きな違いはありません。

ただ、こちらの知っている限りで、FPath は、GetSaveAsFilename　では、生きないはずですが、カレントディレクトリが、そこと同じである限りは問題ないようです。

なお、３回の名前を付けて保存画面でたりするのは、ThisWorkbook モジュールに、マクロの余計なものが残っているせいだと思います。

お礼

わざわざありがとうございます＞＜
ThisWorkbook モジュール・・・
コピーした時によけいな物までしてしまったor消し損ねていた
のかもしれないですね・・；；
本当にありがとうございました＞＜

回答No.12

onlyrom

もう登場することはないと思ったのですが、登場です。(^^;;;

＞ふつうのブック（xls）では３回保存ダイアログが出る

当方ではテンプレートもふつのも１回しか表示されませんでしたが。。。
ま、それは暇を見つけて調べてみませう。

＞あの保存時にポコッと開くエクセルファイルできっとVBA削除の処理を
してるんですかね？＠＠

コードを一行ずつ読んでいってみてくださいな。
答えは、そこにあります！(^^;;;

さてさて、実践ということで今度は以下の▲▲▲▲▲コードを２つ追加して、試してみてください。
テンプレートだけでいいです。
実際の業務ではその２つのコードは入れる場面が多くなります。　
詳しくはヘルプを覗くこと。

'-----------------------------------------------
Sub ファイルに名前を付けて保存()
　Dim 既定ファイル名 As String
　Dim 保存ファイル名 As Variant

既定ファイル名 = FPath & "\" & Range("T1") & Format(Range("U1"), "0000") & Range("B1") & ".xls"

保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名)

　　If 保存ファイル名 = False Then
　　　　MsgBox "保存は中止されました"
　　　　Exit Sub
　　End If

Application.ScreenUpdating = false　　'▲▲▲▲▲

　ActiveWorkbook.SaveCopyAs 保存ファイル名

　Dim NewBook As Workbook
　Set NewBook = Workbooks.Open(保存ファイル名)

　Dim myVBA As Object
　For Each myVBA In NewBook.VBProject.VBComponents
　　　With myVBA
　　　　If .Type = 100 Then
　　　　　.CodeModule.DeleteLines 1, .CodeModule.CountOfLines
　　　　Else
　　　　　Application.VBE.activeVBProject.VBComponents.Remove myVBA
　　　　End If
　　　End With
　Next myVBA

　NewBook.ActiveSheet.Shapes(1).Delete
　NewBook.Close True

　Set NewBook = Workbooks.Open(保存ファイル名)
　NewBook.Close True

Application.ScreenUpdating = True　　'▲▲▲▲

'ブックとエクセル終了
　Application.Quit
　ThisWorkbook.Close False

End Sub
'----------------------------------------------------　

今回は当方も新しい発見ができました。
そして錆付いた頭の体操もさせていただきました。
感謝します。。。。(^o^)^^^

思うに、質問者はなかなか頭の回転が速いし、何にでも物怖じせずにトライする方だとお見受けします。
何故なら、本のコードをペタリと貼り付けて実践に利用する度胸があるのですから。。(^^;;;
そのまま、ＶＢＡ、まっしぐらでいけば瞬く間に習得できるだろうと考えます。
頑張ってくださいな。

お礼

いろいろとありがとうございました＞＜

補足

ほむほむ。。スッキリしました！
ありがとうございます＞＜本当に長々と。。
自分、VBAの怖さをわかっていないとも言いますが・・
これからもどんどん頑張りたいと思います！ありがとうございました！

回答No.11

onlyrom

書き忘れあり、(^^;;;

回答のコードを使うときは、
雛形見積書はテンプレートでもいいし、ふつうのエクセルブックでもＯＫです。

雛形見積書.xlt　　
雛形見積書.xls

どちらでも可。

補足

ありがとうございます！
先ほどので無事動きました！
保存する時にexcelファイルが１つ起動してから終了するんですね（＠＠
雛形見積書はxltでやれば全く問題なかったのですが
普通のxlsでやったら３回の名前を付けて保存画面が出ました…（汗
ファイル名が・・
１度目は”08-0004K.xls”で保存画面が出て
２度目は”08-0004K1.xls”
３度目が”08-0004K2.xls”
２度目のにはマクロが削除されているのですが１．３度目のファイルには
マクロが付きっぱなしみたいです…。
とはいえ、テンプレートで使うので問題なしです♪

あの保存時にポコッと開くエクセルファイルできっとVBA削除の処理を
してるんですかね？＠＠

回答No.9

onlyrom

大体のことは分かりました。
昨日No7の回答を投稿する時点でボタンからでも全てのマクロ削除のコードは出来ていましたが、
一応、実際の流れを聞いてからアップしようと、、、、
が、Wendy02さんへの補足を読んでまたまた疑問が出てきました。
こら、こら、(^^;;;

＞FPath = "C:\Documents and Settings\まり\デスクトップ\指示"
＞既定ファイル名 = "C:\Documents and Settings\まり\デスクトップ\指示\記入済\"

見積り番号を求めるフォルダー（指示）と保存するフォルダー（指示\記入済）が違ってますが、
それでいいのですか？
質問者のコードのままでは見積り番号は【常に同じ】になりますよね。
ま、それはちょこと修正するだけで済むのですが、フォルダーを違える意味が分かりません。

それから、"C:\Documents and Settings\まり\デスクトップ"
これでいくと、４人の担当者みな、このアカウント「まり」のデスクトップに保存するようになってますが、それでいいのですか？
まさか、４人それぞれがそれぞれのアカウントでログインして、それぞれのディスクトップ上に保存するということではないでしょうね。

担当者４人とも「まり」でログインして、
＞FPath = "C:\Documents and Settings\まり\デスクトップ\指示"
＞既定ファイル名 = "C:\Documents and Settings\まり\デスクトップ\指示\記入済\"
このフォルダー違いもそのままでいいなら、コードを書き直してアップします。

ごちゃごちゃ質問して五月蝿いなぁ、と感じているかもしれませんが、
まともなコードを書くためには、特に目の前にないものを言葉だけでイメージしながら書くためには、必要不可欠のことなので、悪しからず。(^^;;;

頑張っている人には完成するまでお付き合いしなければ。(^o^)
皆で解決に向けて努力しませう。

当方の尊敬してやまないWendy02さんの目から鱗のコード期待しています。

補足

あわわっ＞＜
コピーミスです＞＜；すみません
どちらも指示\記入済になります・・・
そしてC:\Documents and Settings\まり\デスクトップ"
の件ですがこれは後で書き換え予定です・・・
自分の家でやったり会社でやったりとしてるので
持ち運びに便利？なように現状こうしてます。。

そして全然五月蠅く感じていません！勉強になります！
元々は条件式書式と関数で見積書を作り始めたけど
見積番号取得の為にVBAに初めて手を出し・・・。
これを機にもっとVBAが好きになれたらなと思います＞＜
（いつかはこれを使って見積番号一覧表みたいのなど頑張りたいと思います！）

※お礼をいつ書こうかと思うのですが、FAQにお礼をすると投稿が
　出来なくなるとか書いてあったので（そんな意味合いが？）
　ひたすら補足書きしてます。
　初めてOKWaveでの投稿でして・・変な書き方だったらすみません・・
　終わったらお礼を書きたいと思います＞＜

回答No.8

Wendy02

こんにちは。#6の回答者です。

>最初に書かれてなかったボタンクリックで保存の件

#7の補足の内容からのイメージですが、単刀直入に、その保存ボタン（たぶん、フォームツールボタン）から、作ったほうが早いですよ。

ここに書かれている人たちは、それなりに腕自慢の人たちですから、かなり高度なことを考えているわけです。いわゆるゼロ・サムだから話が難しくなるのです。最終的には、標準モジュール自体の削除までしないと、うまくいかないはずです。それでは、大変です。

今までの話を振り出しに戻って、そのフォームツールボタンのマクロを見せてくだされば、それにあわせたものを作ります。

今のところ、可能かどうかは別として、そこから発展させるマクロのアイデアは持っています。

とりあえず、そのボタン用のマクロを見せてくださいませんか？

お礼

ありがとうございました＞＜
今度からは質問する時は細かい情報も載せようと思います。
ながながとありがとうございました＞＜

補足

うぅ。。。言葉足らずですみません・・・
フォームでボタンを作って（フォームツールボタン？）
それが【名前を付けて保存ボタン】なんです。。紛らわしいですね。。。（泣

振り出しに戻して、自分の作った内容＆やろうとした目的等を書きます。

【Module1】
Const FPath = "C:\Documents and Settings\まり\デスクトップ\指示"
Sub Auto_Open()
'xlsファイル検索
With Application.FileSearch
.NewSearch
.Filename = "*.xls"
.FileType = msoFileTypeAllFiles
.LookIn = FPath
.SearchSubFolders = False
.Execute

Cells(1, 21).Value = .FoundFiles.Count + 1
Cells(1, 21).NumberFormat = "0000"
End With
End Sub

【module2】
Sub ファイルに名前を付けて保存()
Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = "C:\Documents and Settings\まり\デスクトップ\指示\記入済\" & Range("T1") & Range("U1") & Range("B1") & ".xls"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名)
If 保存ファイル名 = False Then
MsgBox "保存は中止されました"
Else
ActiveWorkbook.SaveAs 保存ファイル名
End If
End Sub

です。T1には年数が入り、U1にはModule1で出てる見積番号。B1には担当者名を書いてます。
本日、本をみて保存先も指定できる事を知り、保存する時に
指定保存先が出るようにしました。
また、module2のSaveCopyAsもSaveAsに変更致しました。
フォームツールボタンのマクロはmodule2を登録しています。

（自分のVBAの目的）
見積番号が手打ちだったので番号の重複があったりしてたのですが…
営業のPCが全員windowsになるのでexcelで統一する事になりました。
自動で見積番号が出ないかな？という発想から。

見積番号でファイル名を保存する時間違えた数字を保存する人が
いたのでこれも自動ででないかな？と。

更に、いつも社長が保存した見積書が消えたとか保存先を
考えずに保存して他の人を呼び出すのでそれを防止する為に
保存先をわざわざ自分で指定しなくても済むようにしたいと思いました。
（マイドキュメントから指定フォルダまで教えてもわかってくれない…泣）

いざ作り終わった見積書を立ち上げるとマクロ云々ではいを
押してしまうと見積番号が変わってしまうため間違えて保存しない
ように作り終わった見積書にはVBAを消したいと思いました。

※見積書にはその場で作り終えるものもあれば
　１ヶ月後に作り終える物もあります。
（見積ナンバーで発注をかけているので金額が決まっていなくても
　金額０円の見積書だけ発行してあとで金額を記入というのがある）

回答No.7

onlyrom

再度の登場、onlyromです。

先ず、一言。
当方もWendy02さんの意見に賛成です。
コードでコードを扱うのは質問者のスキルがも少しアップしてからの方がいいかもしれませんね。

さて、本題。
こういった質問においては微妙な事柄が問題になったりしますので最初から全ての情報を提示すべきだと考えます。
でないと解決までに何回も遣り取りを繰り返すことになります。

で、最初に書かれてなかったボタンクリックで保存の件ですが
SaveAs（何故SaveCopyAsにしてあるか不明）のある標準モジュールは削除されません。
それは考えてみればお分かりになるのではないでしょうか。

ま、それはそうとして、疑問点あり。

なぜ「保存」ボタンが必要なのか。
「閉じるボタン」を使用しない理由がいまいち不明。
またボタンがあるということはコードの削除のほかにボタンの削除も必要だと思うがそれには一言も言及してないのは？

仮に「保存」ボタンを使うとして、ユーザーがそのボタンを押さずに
「閉じるボタン」などを押したら？？？

そこらあたりのことを詳しく補足された方がいいかと。

補足

お返事有難うございます。
こんなに長くなってしまったのも私が質問を書く時に情報が足りなかったからだと実感しています。
回答してくださった皆様には本当に申し訳ありません。
もっと簡単に出来る物だと思っていました。
はじめてVBAをやる自分には無謀な行為なんだと実感しました。
反感を食らうのを覚悟で正直に書きます。

●で、最初に書かれてなかったボタンクリックで保存の件

これはModule2に記入されていた物でエラーで出てないから関係ないだろうと
自己判断で表記しませんでした。。。すみません。。

●何故SaveCopyAsにしてあるか不明

できるEXCELマクロ＆VBA等の本を見ながら作ったので
そこに表示されていたのをそのまま打ちました。。

●なぜ「保存」ボタンが必要なのか。
「閉じるボタン」を使用しない理由がいまいち不明。
またボタンがあるということはコードの削除のほかにボタンの削除も必要だと思うがそれには一言も言及してないのは？

文章内の見積番号とファイル名は同じようにつけるように社内でしてるのですが
間違った番号でファイル名をつける人が居まして、
なので自動でファイル名が入る方法はないかな？と本を読んでいたら
対になって「名前を付けて保存」ダイアログボックスを表示する方法+
自動的にファイル名が入力されると言うのを見つけてこれを使おう！
としました。。
（メニューバーの名前を付けて保存を押した時に自動でファイル名が
出るVBAが載っていた無かったこっちにしたともいいます・・・）
今までイラストレータで見積書を書いていた会社なので
右下に作ってある大きい保存ボタンを押して保存してくださいと
伝えればそのボタンを押してくれるので・・・。
ちなみに使用者は4名ほどです。
ボタンの削除が必要かどうかですが、これはあっても印刷で出ない
区域にあるし押してもエラーしか出ないからいいかな…と安直な考えです。

ほんとに、初心者な考えで申し訳ありませんでした。

回答No.6

Wendy02

こんばんは。

コードを削除するコードというのは、一応、私の中では、封印した禁じ手のひとつのコードですから、その方法は、考慮しないことにします。たぶん、Office 2003 以下の中でも、マクロを切り落とすツールなどが、Microsoft 側自身にあるような気がしますが、今のところ知りません。

一応、アドインを作って成功しましたが、以下は、対象複雑です。
本来は、テンプレートでなくても十分だと思います。

なお、うまく行くようでしたら、最後に、プロジェクトのロックをしてください。開くとややこしいです。

'ThisWorkbook モジュール

Private WithEvents App As Application
Private i As Long

Private Const FPath = "C:\指示書\"
Private Const TMPL_NAME = "Testfile1" 'テンプレートの名前
Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
　　Dim w As Object
　　Dim flg As Boolean
　　Dim i As Long
　　Dim cPath As String
　　Dim fName As String
　　For Each w In Workbooks
　　　 If w.Name Like TMPL_NAME & "*" Then
　　　　 flg = True
　　　 End If
　　Next w
　　If flg = False Then Exit Sub
　　cPath = CurDir
　　ChDir FPath
　　 With Application.FileSearch
　　　　.NewSearch
　　　　.Filename = "*.xls"
　　　　.FileType = msoFileTypeAllFiles
　　　　.LookIn = FPath
　　　　.SearchSubFolders = False
　　　　.Execute
　　　　i = .FoundFiles.Count + 1
　　　　ActiveWorkbook.Worksheets("Sheet1").Range("U1").Value = i
　　End With
　　With ActiveWorkbook.Worksheets("Sheet1")
　　　　If .Range("T1").Value = "" Or .Range("U1").Value = "" Or Range("B1").Value = "" Then
　　　　　 MsgBox fName & vbCrLf & "ファイル名には要件が足りません。", 48
　　　　　 Cancel = True
　　　　　 Exit Sub
　　　　Else
　　　　　fName = .Range("T1").Value & "-" & Format(.Range("U1").Value, "00000") & "-" & .Range("B1").Value
　　　　End If
　　End With
　　Application.EnableEvents = False
　　ChDir FPath
　　With Application.Dialogs(xlDialogSaveAs)
　　　　.Show fName & ".xls"
　　End With
　　Cancel = True
　　ChDir cPath
　　Application.EnableEvents = True
End Sub

Private Sub Workbook_Open()
　On Error Resume Next
　　Set App = Application
　On Error GoTo 0
End Sub

Sub stopmacro()
'予備のマクロ
　 Set App = Nothing
End Sub
Sub goApp()
'予備のマクロ
　Set App = Application
End Sub

回答No.5

onlyrom

雛形見積書ブックは必ずテンプレートであること（拡張子が、.ｘｌｔ　）

（処理内容）
見積書.xlt（テンプレート）を起動し、見積書を作成するが、
新しい見積書はＶＢＡを除いて保存する

見積書.xlt（テンプレート）のThisWorkbookモジュールに以下を貼りつけ。

'------------------------------------------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
　Dim myVBA As Object
　For Each myVBA In ThisWorkbook.VBProject.VBComponents
　　　With myVBA
　　　　　If .Type = 100 Then
　　　　　　.CodeModule.DeleteLines 1, .CodeModule.CountOfLines
　　　　　Else
　　　　　　Application.VBE.activeVBProject.VBComponents.Remove myVBA
　　　　　End If
　　　End With
　Next myVBA
End Sub
'----------------------------------------------

上記コードで、
テンプレートのSheet、ThisWorkbookに書かれたコードはコードのみ削除
Userformは、UserFormまるごと削除
標準モジュールもまるごと削除されます。

●注●
見積書がテンプレートでない（拡張子が、xls　）場合は、
保存するときに、「名前を付けて保存」すればＯＫですが、
ユーザーが間違う危険性があるので、雛形見積書はテンプレート(xlt）の方がいいでしょう。

以上。

補足

ありがとうございます！できました！
雛形見積書もxltとしてテンプレートにしました。
ですが・・・
見積書.xltを立ち上げ、ツールバーの名前を付けて保存や上書き保存を押して
自分で見積番号を書いて保存すると保存したxlsはVBAがきれいになくなりよかったのですが・・・
自分で作ったボタンアイコン（？）の保存ボタンを押すと
VBAが消えないで保存されてしまうようです。。
書き方がおかしいのでしょうか？
自分は見積書の右下に保存ボタンを作り、
module2のマクロを登録しています。
module2の内容は以下の通りです。

Sub ファイルに名前を付けて保存()
Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = Range("T1") & Range("U1") & Range("B1") & ".xls"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名)
If 保存ファイル名 = False Then
MsgBox "保存は中止されました"
Else
ActiveWorkbook.SaveCopyAs 保存ファイル名
End If
End Sub

使用者に保存する時のファイルの名前を書く手間を
省いて欲しいと言われたので
各セル：T1（年号）・U1（見積番号）・B1（担当者名）のセルを
打たずに表示されるようにしています。

回答No.4

okormazd

>エクセルVBAを保存時に消したい
のですか。

つぎのコードでどうでしょう。
これで保存すれば、次に開くときマクロ確認のダイアログはでない。

保存するとこのBOOKのvbaコードの類は全部削除される(はず)。
ただし、
EXCELの設定を次のように変える。
メニューバー
ツール―マクロ―セキュリティ―信頼できる発行元
で、
「Visual Basicプロジェクトへのアクセスを信頼する」
にチェックを入れる。

注意
うまくできないとExcelの動作がおかしくなることがあるかもしれない。

ThisWorkbookのコード

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
delvbitem
End Sub

module1のコード

Sub delvbitem()

On Error GoTo trap

Dim vbprj As Object, vbcom As Object, vbmei() As String

Set vbprj = Application.VBE.ActiveVBProject
Set vbcom = vbprj.VBComponents

n = vbcom.Count

ReDim vbmei(n)

For i = 1 To n
vbmei(i) = vbcom.Item(i).Name
Next

For i = 1 To n
vbmei0 = vbmei(i)
vbtype = vbcom.Item(vbmei0).Type
If vbtype = 100 Then
l = vbcom.Item(vbmei0).CodeModule.CountOfLines
If l > 0 Then
vbcom.Item(vbmei0).CodeModule.DeleteLines 1, l
End If
Else
vbcom.Remove VBComponent:=vbcom.Item(vbmei0)
End If
Next
Exit Sub

trap:
MsgBox Err.Number & Err.Description

End Sub

補足

ThisWorkbookのコードに記入し、
module1と2は使用しているので3に
記入してみたのですが
VBAが消えました＠＠

消えて良いのですがテンプレートのVBAが消えてしまって………
とはいえ自分の最初の質問の仕方もおかしかったのかもしれません。
すみません。。。
見積テンプレートにVBAがついていて保存して出来上がるxlsファイル
にもVBAが付いてしまうので出来上がるxlsファイルのVBAを消したいのです。

回答No.3

Wendy02

こんばんは。

>何が原因なのでしょうか？

原因は、アドインが開いた時点では、書き出すブックとシートが指定されていません。その場所が特定できないのでエラーになります。

見積書式を作成する場合に、テンプレートを使うのか、それとも、新規のブックを使うのか、それによっても本来は違ってきます。

>名前を付けて保存する時はその見積番号が保存する時にファイル名になるようにVBAを作成しました。

というのは、何に名前をつけるのか分からないのです。

足りない情報があるので、こちらで想像して、サンプルコードを作りました。これを参考にして考えてみてください。

ThisWorkbook モジュールに入れます。そして、アドインファイルにします。セルは使いません。保存するときのイベント時に出します。

なお、
cPath = CurDir
ChDir FPath

とあるのは、保存時に、フォルダを特定しないと、カレントフォルダに保存してしまい、次のファイルのカウントが正しくされません。保存場所があちこちに変わる場合は、CustomProperties を使わなくてはなりません。

------------------------------------------

Private Const FPath = "C:\指示書"
Private WithEvents App As Application

Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i As Long　'ファイルのカウント
Dim cPath As String
cPath = CurDir
ChDir FPath
With Application.FileSearch
　　.NewSearch
　　.Filename = "*.xls"
　　.FileType = msoFileTypeAllFiles
　　.LookIn = FPath
　　.SearchSubFolders = False
　　.Execute
　　i = .FoundFiles.Count + 1
End With
Application.EnableEvents = False
With Application.Dialogs(xlDialogSaveAs)
　　'保存ダイアログとファイル名
　.Show "file" & CStr(i) & ".xls"
End With
Application.EnableEvents = True
Cancel = True
ChDir cPath
End Sub

補足

お返事遅れてすみません。ありがとうございます。

>>名前を付けて保存する時はその見積番号が保存する時にファイル名になるようにVBAを作成しました。
>というのは、何に名前をつけるのか分からないのです。

今自分がやっている事はファイル（テンプレート？）を立ち上げると
指定フォルダにあるxlsファイルをカウントし、指定したセルにそのファイル数＋１の数字が４桁表示で出るようにVBAで指定しています。（Module1）
そして自分で名前を付けて保存ボタンを画面に作成し、そのボタンに

Sub ファイルに名前を付けて保存()
Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = Range("T1") & Range("U1") & Range("B1") & ".xls"
・・・・・・（略

と、数カ所のセルの文字を拾ってファイル名を自分で打たなくて済むように
やってみました。（Module2）

自分のやろうとしている事が文章にしずらくてすみません。。。

【】＝フォルダ
【Cドライブ】－【指示書】－【テンプレ】－Ａさん用見積書.xla(s)
【Cドライブ】－【指示書】－【テンプレ】－Ｂさん用見積書.xla(s)
【Cドライブ】－【指示書】－【テンプレ】－Ｃさん用見積書.xla(s)
【Cドライブ】－【指示書】－　a-08-0001.xls
【Cドライブ】－【指示書】－　b-08-0002.xls
【Cドライブ】－【指示書】－　a-08-0003.xls
【Cドライブ】－【指示書】－　b-08-0004.xls
【Cドライブ】－【指示書】－　c-08-0005.xls
という感じで…。
（a-08-0001.xls等が出来上がったファイル）←マクロを取りたい。

ちなみにファイルの中身はシートが３枚あって
見積書１・控え２・客先３となってます。
見積書１を全部記入すれば控え２・客先３は１を参照してるので
勝手にできあがる仕組みです。

すごく幼稚な作り方だとおもうので恥ずかしいのですが
自分の現状の能力だとこのようなやり方しか思い浮かばなく・・・。