• ベストアンサー
  • 困ってます

excel VBA コピーファイルのマクロ削除

下記3つの、プロシージャを組み合わせて、下記のやりたいことをやりたいのですが、うまくいきません。 どうかご教授の程よろしくお願いいたします。 excelは2000です。 ○やりたいこと 今現在開いているファイルの、コピーをデスクトップに保存して、その保存したブックのマクロ(標準モジュールと、コマンドボタン)を削除したい。 ○自分でやろうとすると コピーをデスクトップに保存すると、コピー元のファイルが勝手に閉じてしまい、コピー先のファイルのマクロを削除できない。 '■デスクトップにコピー保存 Sub copysave() Dim 場所 As String 場所 = CreateObject("WScript.Shell").SpecialFolders("Desktop") ActiveWorkbook.SaveAs Filename:=場所 & "\" & Format(Date, "yyyymmdd") & "○◆△.xls" End Sub '■標準モジュールの削除 Sub DelModule() Application.VBE.ActiveVBProject.VBComponents.Remove _   Application.VBE.ActiveVBProject.VBComponents("Module1") Application.VBE.ActiveVBProject.VBComponents.Remove _   Application.VBE.ActiveVBProject.VBComponents("Module2") End Sub '■CommandButtonの削除 Sub DelCommandButton() Dim c As Excel.OLEObject For Each c In Worksheets(1).OLEObjects   If TypeOf c.Object Is Msforms.CommandButton Then c.Delete End If Next End Sub

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数1248
  • ありがとう数1

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

  • ベストアンサー
  • 回答No.1
  • keithin
  • ベストアンサー率66% (5278/7939)

オリジナルブックの標準モジュールに,次のマクロを登録してある。 #オリジナルブックの全シートを複製する #オリジナルブックの標準モジュールは置き去りにする #オリジナルブックの1枚目のシートにあるControlツールボックスを全て削除する  (そうでない場合は,ご質問に掲示されたマクロを流用する) sub macro1()  dim myPath as string  dim myFile as string  mypath = createobject("WScript.Shell").specialfolders("Desktop") & "\"  myfile = format(date, "yyyymmdd") & "xyz.xls"  thisworkbook.worksheets.copy  activeworkbook.worksheets(1).oleobjects.delete  activeworkbook.saveAs filename:=mypath & myfile end sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

keithin様 完璧なお答えでした。 ありがとうございました。

関連するQ&A

  • VBAでのマクロ削除

    複数のExcelファイルを読み込み必要なデータのみをsheet1に寄せ集め最後にExcel形式で保存するというコードを書きました。保存したExcelファイルは、次回同じVBAのコードからWorkbooks.Open Filenameで開く必要があるため、マクロを削除してから保存しないといけないことに気付きました。 ACompo = ExcelWorkbook1.VBProject.VBComponents.Item("module1") ExcelWorkbook1.VBProject.VBComponents.Remove (ACompo) 最終的にやりたいことは、3つのフォームと2つの標準モジュールを削除したい(ワークブックモジュールにもコード書いてありますのでそれも) ということになります。 よろしくお願いします。

  • EXCEL2003VBA 「マクロでモジュール解放」

    質問番号:5548045の関連質問です。 EXCEL2003VBA で、セキュリティ設定で『Visual Basic プロジェクトへのアクセス』にチェックを入れて、Module1に下記のように「モジュール解放」マクロを作成しましたが、Module1が削除されません。(1)を削除して、手動操作で変更を保存でファイルを閉じるとModule1も削除されます。 Module1の削除も全てマクロで行うやり方を教えてください。 With ThisWorkbook.VBProject.VBComponents .Remove .Item("Module1") .Remove .Item("Module2") .Remove .Item("Module3") End With ActiveWorkbook.SaveAs Filename:="D:\TEST" ActiveWorkbook.Close ・・・(1)

  • 標準モジュールを削除したい。(VBA)

    VBAで、VBAの標準モジュールを削除したいのですが、なかなか出来ません。たぶん、コレクションについての認識があまいからだと思います。VBComponents コレクションのobject.Remove(component)のヘルプには、VBProjects コレクションには、スタンドアロン プロジェクトを指定します。とありますが、そもそもスタンドアロンプロジェクトって何ですか?Application.VBE.VBProjects(4).VBComponents(1).とするとコレクションでなくなってしまいますが、どうやってモジュールと特定するのでしょうか?どなたか詳しい方いらっしゃいましたらご指導願います。よろしくお願いいたします。 VBIDEのライブラリーです。

  • ExcelVBAでモジュールシートの内容更新を自動で行いたい

     Excelで、ファイルを開いたときに、そのファイルのモジュールシートの内容を自動的に更新するVBAを書きたいのです。  gooで質問しながらも、とりあえず自分で以下のように作ってみました。どのような方法にしたかというと、Auto_Openでファイルを開いたときに、まず対象となる更新前のモジュールシートを削除(更新前が存在しない場合はエラーになるのでOnErrorGotoで回避)し、その後、あらかじめ更新後の内容を記述しておいたC:\定義.txtというファイルを更新後のモジュールシートとして付け加えるというものです。  とりあえずはうまく内容更新できたのですが、ファイルを開いた際に自動的同時に開かれるBook1.xlsなどのファイルにも更新後のモジュールシートが付け加わってしまうのです。つまり、更新させたいファイルだけでなく、その他のファイルも更新の対象となってしまう場合があるのです。  いろいろ試してみると、すでにExcelを立ち上げた状態で当ファイルを開いた場合は、それ以前に開いていたファイルが更新対象になることはないようです。Excelを立ち上げていない状態からエクスプローラなどで当ファイルを開き、同時に自動的にExcelやBook1などのファイルも立ち上がる際に、Book1なども更新対象となってしまうようです。  更新させたいファイルのモジュールシートだけを更新するには、どのようにVBAを書いたらいいのか、ヒントくらいでも結構ですのでご教授ください。 Sub Auto_Open() 削除 追加 End Sub Sub 追加() With Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_StdModule) .Name = "定義" .CodeModule.AddFromFile ("C:\定義.txt") End With End Sub Sub 削除() On Error goto trap Application.VBE.ActiveVBProject.VBComponents.Remove _ Application.VBE.ActiveVBProject.VBComponents("定義") Trap: End Sub

  • 「エクセルファイルが開いていたら開かない」としたい

    「エクセルファイルが開いていたら開かない」としたいです。 VB2010です。 -------------------------------------------------------------- Imports Microsoft.Office.Interop '参照設定済み Module Module1 Sub ExcelOpen() Dim ExcApp As Excel.Application Dim book As Excel.Workbook Dim MyPath As String MyPath = "C:" ExcApp = CreateObject("Excel.Application") ExcApp.Visible = True book = ExcApp.Workbooks.Open(MyPath & "\test.xlsm") End Sub End Module -------------------------------------------------------------- で、ファイルを開くのですが、既にファイルが開いている場合は、2個開いてしまい、 最後に開いたファイルが読み取り専用になってしまいます。 IFで、開いているかどうかを取得して、 開いているのなら「既に開いています」として、ExitSubがしたいです。 ご協力よろしくお願いします。

  • アクセスからエクセルファイルを全て閉じたい

    アクセスからエクセルファイルを全て閉じるにはどうすればいいでしょう?(保存して閉じたいです) エクセルファイルは名前やファイル数はランダムです。 アクセスの標準モジュールに Sub Test1() Dim ExcelApp As Object Set ExcelApp = CreateObject("Excel.Application") ExcelApp.Application.Visible = False Set ExcelApp = Nothing End Sub と書きました。 このあいだにコードをいれるのですが 思いつきません。 まず数を取得して 一つ一つ保存→閉じるかな?と思い MsgBox ExcelApp.Worksheet.Count を入れてみましたが エラーになりました。 オフィスのバージョンは2003です。 ご教授よろしくお願い致します。

  • VBA マクロを削除して保存したい

    お世話になります。 下記のコードでシートをコピーし、新規ブックに保存しています。 マクロを削除して保存するにはどのようにしたらよいでしょうか? コードはsheet5に記入しています。 ちなみにセルだけをコピペして、シートの設定もコピーできるコード もあるハズですよね? 書式、列の幅、行の高さ、ページ設定、をコピーしたいので、 どなたかご教授お願いします。 Private Sub 保存() Dim ns As Workbook Dim msg As String Sheets("sheet5").Copy Set ns = ActiveWorkbook msg = IIf(Application.Dialogs(xlDialogSaveAs).Show(ARG1:="" & ".xls", ARG2:=1), "保存", "キャンセル") ns.Close (False) Set ns = Nothing MsgBox msg & "しました。" End Sub

  • Workbook_openでマクロが実行されない

    ExcelのVBAで起動時にマクロを実行させたいのですが、 「メソッドまたはデータメンバが見つかりません。」 とのエラーが出て実行出来なくて困っています。 プログラム内容は *ThisWorkbook* Private Sub Workbook_Open() Module1.tasu End Sub *標準モジュール(Module1)* Private Sub tasu() Dim a As Byte a = 3 Range("a1") = a End Sub 使用しているソフトはExcell2003、VB6.5です。 よろしくお願いします。

  • Excel2010のVBAで起動時に連番表示&保存

    【再掲載&追加情報です】 ずっとwindowsXP SP3を使用していたのですが(Excel2002 SP3もそのまま) 今回急遽社内のパソコンが2台(1台は自分のです)だけWindows7に変わりました。 その2台だけExcelも2002から2010に変わったのですが、使用しているファイルで記述してる FileSearchが使えないとあとから知りました。(泣) ネットで検索してFileSystemObjectを代わりに使用するというのを知りましたが 初心者の為理解が難しく・・・。 申し訳ありませんが記述の変更方法を教えていただけないでしょうか? (1)フォルダーは ”C:\指示\記入済” に出来たExcelファイルを保存してます (2)番号は指定フォルダ内のエクセルファイルをカウントしてその数+1を   U1のセルに表示させています。 (3)作成した保存ボタンで新見積書を保存する    但し、マクロコードとボタンを削除したものを保存する (4)新見積書の保存後はブック、エクセルともに終了する **************現在使用中データ************** --- Module1 ---- Public Const FPath = "C:\指示\記入済" 'xlsファイル検索 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 ******************************************** 上記がExcel2002で問題なく動いている記述です。 最初Excel2010で起動してエラーが出たので検索したとき、てっきりFileSearchだけが問題 だと思っていたのですがもしかして他にもあったのでしょうか? --- Module1 ----は、先ほど質問したときに Public Const FPath = "C:\指示\記入済" 'xlsファイル検索 Sub Auto_Open() Dim tmp as String Dim i as Long tmp = Dir(FPath & "&#165;*.xls") Do While tmp <> "" i = i + 1 tmp = Dir() Loop Cells(1, 21).Value = i+1 Cells(1, 21).NumberFormat = "0000" End Sub に変更したら動くようになりました。 ただ、作成した保存ボタンを押すと指定した場所に指定したセルの文字を拾って ファイル名を表示させるまでマクロに登録(Module2)したのですが、 指定したフォルダは開いてるのですがファイル名が空欄のままです。 更にそれに手打ちでファイル名を打ち、保存すると 実行時エラー1004 プログラミングによるVisualBasicプロジェクトへのアクセスは信頼性に欠けます と表示されます・・・。 デバックを押すと For Each myVBA In NewBook.VBProject.VBComponents の部分が黄色くなってました>< 他に情報としては このファイルはxlt(テンプレート)にしています。 使用者たちにはファイル名を打たせないように上記のようにしました。 再度宜しくお願いします・・・。 何度もお手数をおかけしまして申し訳ありません。。。

  • エクセルVBA 10分後にエクセル自動終了&カウン

    どなたかご教授お願い致します。 ・エクセルの当該ブックを、起動10分後に自動終了(保存しない)させる ・開いている間は、10分のカウントダウンを「分:秒」でA1セルに表示する 以上を実行したいのですが、VBAは全く素人ですので、うまくいきません。 見よう見まねで、以下のようなことをしましたが、結局ダメでした。 何卒、よろしくお願い致します。 ThisWorkbook Workbook Open Private Sub Workbook_Open() test01 Application.OnTime Now + TimeValue("00:10:00"), "終了" End Sub 標準モジュール Module1 Sub 終了() ThisWorkbook.Close Savechanges:=False Application.Quit End Sub Sub test01() With Sheets("バックアップ").Range("A1") .Value = Time .NumberFormatLocal = "mm:ss" End With Application.OnTime Now + TimeValue("0:00:01"), "test01" End Sub