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

解決済みの質問

エクセル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
でエラーが出てしまうようで。。原因がわかりません。
何が原因なのでしょうか?><

投稿日時 - 2008-03-13 13:59:59

QNo.3859010

すぐに回答ほしいです

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

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

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

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

'--- 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メソッドを使用しなければいけません。
●●●の間の2行は、お呪い?ということで。。
これ新しい発見でした。(感謝)


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

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

投稿日時 - 2008-03-18 11:10:04

お礼

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

投稿日時 - 2008-03-18 15:45:11

ANo.10

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

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

回答(13)

ANo.13

こんばんは。

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

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

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

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

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

投稿日時 - 2008-03-18 23:19:25

お礼

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

投稿日時 - 2008-03-19 07:52:12

ANo.12

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

>ふつうのブック(xls)では3回保存ダイアログが出る

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

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

コードを一行ずつ読んでいってみてくださいな。
答えは、そこにあります!(^^;;;
 
さてさて、実践ということで今度は以下の▲▲▲▲▲コードを2つ追加して、試してみてください。
テンプレートだけでいいです。
実際の業務ではその2つのコードは入れる場面が多くなります。 
詳しくはヘルプを覗くこと。

'-----------------------------------------------
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、まっしぐらでいけば瞬く間に習得できるだろうと考えます。
頑張ってくださいな。
 

投稿日時 - 2008-03-18 14:51:36

補足

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

投稿日時 - 2008-03-18 15:28:54

お礼

いろいろとありがとうございました><

投稿日時 - 2008-03-18 15:49:57

ANo.11

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

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

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

どちらでも可。
 

投稿日時 - 2008-03-18 11:27:39

補足

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

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

投稿日時 - 2008-03-18 13:28:04

ANo.9

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

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

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

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

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

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

 
頑張っている人には完成するまでお付き合いしなければ。(^o^)
皆で解決に向けて努力しませう。
 
当方の尊敬してやまないWendy02さんの目から鱗のコード期待しています。
 

投稿日時 - 2008-03-17 23:43:38

補足

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

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

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

投稿日時 - 2008-03-18 08:01:00

ANo.8

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

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

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

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

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

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

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

投稿日時 - 2008-03-17 15:05:53

補足

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

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

【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を消したいと思いました。

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

投稿日時 - 2008-03-17 17:39:07

お礼

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

投稿日時 - 2008-03-18 15:59:08

ANo.7

再度の登場、onlyromです。

先ず、一言。
当方もWendy02さんの意見に賛成です。
コードでコードを扱うのは質問者のスキルがも少しアップしてからの方がいいかもしれませんね。
 
さて、本題。
こういった質問においては微妙な事柄が問題になったりしますので最初から全ての情報を提示すべきだと考えます。
でないと解決までに何回も遣り取りを繰り返すことになります。

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

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

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

仮に「保存」ボタンを使うとして、ユーザーがそのボタンを押さずに
「閉じるボタン」などを押したら???
 
そこらあたりのことを詳しく補足された方がいいかと。
 

投稿日時 - 2008-03-16 21:52:30

補足

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

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

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

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

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

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

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

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

投稿日時 - 2008-03-17 11:17:29

ANo.6

こんばんは。

コードを削除するコードというのは、一応、私の中では、封印した禁じ手のひとつのコードですから、その方法は、考慮しないことにします。たぶん、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

投稿日時 - 2008-03-16 20:09:59

ANo.5

雛形見積書ブックは必ずテンプレートであること(拡張子が、.xlt )

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

見積書.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 )場合は、
保存するときに、「名前を付けて保存」すればOKですが、
ユーザーが間違う危険性があるので、雛形見積書はテンプレート(xlt)の方がいいでしょう。

以上。

投稿日時 - 2008-03-15 12:17:00

補足

ありがとうございます!できました!
雛形見積書も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(担当者名)のセルを
打たずに表示されるようにしています。

投稿日時 - 2008-03-15 23:42:00

ANo.4

>エクセル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

投稿日時 - 2008-03-14 11:55:09

補足

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

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

投稿日時 - 2008-03-14 19:04:15

ANo.3

こんばんは。

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

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

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

>名前を付けて保存する時はその見積番号が保存する時にファイル名になるように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

投稿日時 - 2008-03-13 19:13:43

補足

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

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

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

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

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

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

【】=フォルダ
【Cドライブ】-【指示書】-【テンプレ】-Aさん用見積書.xla(s)
【Cドライブ】-【指示書】-【テンプレ】-Bさん用見積書.xla(s)
【Cドライブ】-【指示書】-【テンプレ】-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等が出来上がったファイル)←マクロを取りたい。

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

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

投稿日時 - 2008-03-14 18:22:27

ANo.2

別な提案
1)見積書テンプレートシート&VBAというブックを作成する。(マスタ)
2)VBAにて新規ブックを作成し、マスタ内の見積書テンプレートシートを新規ブックにコピーし、余分なシートは削除する。
3)作成したブックを見積書番号+”.xls”という名前で保存する。

これならば、作成した見積書には、VBAは含まれないはずですが、
いかがでしょうか?
見積書を作成するのは、質問者さまではなく、実務担当者でも、一度
マスタを起動してもらい、見積書を作成後、あらためて、見積書編集
を行ってもらうことも可能だと思います。

投稿日時 - 2008-03-13 14:54:23

お礼

お返事が遅くなってすみません。
自分のVBAの知識が無さすぎてできるかどうか。。。(泣

投稿日時 - 2008-03-14 18:21:36

ANo.1

質問者の主旨とは異なるのを承知で、

要するに、最初の1回だけVBAが実行されればよい
というのであれば、
作業用に非表示のセルを用意します。
この非表示のセルが、ブランク(未設定)の場合のみVBAの処理を実行するよう、条件式を追加します。
実行後、非表示セルに、任意の値(文字)を入れます。

このようにすれば、2回目以降、VBAは実行されません。
但し、VBAそのものは残っているため、VBA実行の確認
ダイアログは、起動毎に表示されてしまいます。

投稿日時 - 2008-03-13 14:10:49

お礼

お返事有難うございます。
やっぱりVBAの実行確認画面は修正時は出したくありません。
PCをあまり知らない人達が出るたびに呼ぶので(泣)

空書類をVBA実行しながら立ち上げそれを名前を付けて保存する。
その保存した書類は今後VBAを実行しないので(してはいけない)
VBAを取り除きたい。

最悪はkokoroneさんの方法でも。。。とは思うのですが、
はじめてのVBAで自分なりにココまでがんばれたので
なんとか納得できる物を作りたいと思います。

投稿日時 - 2008-03-13 14:34:19

あなたにオススメの質問