Excelマクロを削除するマクロについての質問です。

質問

Excelマクロを削除するマクロについての質問です。

現在Excel2003で、記入に便利なようにマクロを使って「パソコンボランティア活動報告書」（以下"活動報告書"）を作っています。
この活動報告書をセキュリティ警告（マクロを有効にする等）が出ないようにしてホームページに載せたいので、私なりに「新しいマクロの記録」を使って、「マクロ削除」のマクロを作ってみました。

しかしこれでは今までのマクロは削除されますが、「マクロ削除」マクロが残ってしまいます。
今までのマクロはもちろんのこと、「マクロ削除」マクロを消すためにはどうすればいいのでしょうか？

Sub マクロ削除()
'
' マクロ削除 Macro
'
'
ActiveSheet.Unprotect
ActiveWindow.SmallScroll Down:=9
Range("Q27:R27").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-21
Sheets("リスト項目").Visible = True
Application.DisplayAlerts = False
Sheets("リスト項目").Delete
Cells.Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
Range("E4:P4,J5:AG5,E6:N6,R6:AG6,F7:J7,O7:AG7,C15:AG17").Select
Range("C15").Activate
ActiveWindow.SmallScroll Down:=9
Range("E4:P4,J5:AG5,E6:N6,R6:AG6,F7:J7,O7:AG7,C15:AG17,I27:O27,C28:AG41"). _
Select
Range("C28").Activate
ActiveWindow.SmallScroll Down:=15
Range( _
"E4:P4,J5:AG5,E6:N6,R6:AG6,F7:J7,O7:AG7,C15:AG17,I27:O27,C28:AG41,C42:AG44"). _
Select
Range("C42").Activate
Selection.ClearComments
ActiveWindow.SmallScroll Down:=-36
Range("AC4:AE4,F5:I5,J5:AG5,E6:N6,R6:AG6,F7:J7,O7:AG7").Select
Range("O7").Activate
Selection.ClearContents
Range("E4:P4").Select
ChDir "C:\work"
ActiveWorkbook.SaveAs Filename:="C:\work\yyyymmddパソコンボランティア活動申請及び報告書.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Range("E4:P4").Select

End Sub

回答No.1

keithin · ベストアンサー

標準モジュールに登録したマクロを削除する最も安全な方法は，
sub macro1()
　sheets.copy
　activeworkbook.saveas Filename:="C:\work\yyyymmddパソコンボランティア活動申請及び報告書.xls"
　activeworkbook.close false
　thisworkbook.saveas filename:="C:\work\yyyymmddパソコンボランティア活動申請及び報告書withマクロ.xls"
end sub
などになります。

もし，いまご質問で掲示されたマクロで「登録済みのマクロを削除している」明確な認識があるのでしたら，該当する箇所は
Sheets("リスト項目").Visible = True
Application.DisplayAlerts = False
Sheets("リスト項目").Delete
だけですので，これを上述マクロの先頭部分に追加します。

もし，ご質問に掲示されたのは正直なマクロの全文ではなく編集した内容でしたら，その削って示さなかった範囲にマクロを削除している肝心の内容が含まれていたかも知れません。確認して，そちらも勿論盛り込んでください．
他にも標準モジュールではなくシートにマクロを追加していたときは，同等の手当が必要です。

＃シートモジュールと標準モジュールの使い分けについて理解していない時は，いま「どういう風にエクセルを操作してマクロを登録しているのか」，言い換えると削除したいマクロはどこにどういう操作手順で追加したものなのか，事実を丁寧に添えて追加ご質問を投稿してください。

「マクロを操作するマクロ」はコンピュータウィルスの作成にも通じる技なので，こういった公開の掲示板ではあまり触れないのがマナーになっています。

回答No.2

Wendy02

別のブックに入れて、アクティブ・ブックに対して実行してください。以下のマクロの入ったブックでは出来ません。先頭に$のついたファイルは、バックアッフ元ファイルです。シートのCellsをコピーします。シートのコピーではありません。ただし、以下のマクロは不十分です。ここのサイトでは、文字制限があって、完全なコードは掲示できません。

'
Sub ShCopyTestMacro()
　　Dim sh As Object
　　Dim shCnt As Integer
　　Dim NewSh As Object
　　Dim AcBook As Workbook
　　Dim NewBook As Workbook
　　Dim ext As String
　　Dim sFn As String
　　Dim myPath As String
　　Set AcBook = ActiveWorkbook
　　ext = Mid(AcBook.Name, InStrRev(AcBook.Name, "."))
　　sFn = AcBook.Name
　　If ThisWorkbook Is ActiveWorkbook Then
　　　　MsgBox "このブックには、マクロは実行出来ません。", 48
　　　　Exit Sub
　　End If
　　　myPath = AcBook.Path & "\" '"C:\work\"
　　　AcBook.Save
　　If Dir(myPath & "$" & sFn) <> "" Then
　　　　MsgBox "既に、バックアップが存在しています。" & vbCrLf & _
　　　　"'$" & sFn & "'", 48
　　　　Exit Sub
　　End If
　　With Application
　　　　.Calculation = xlCalculationManual
　　　　shCnt = .SheetsInNewWorkbook
　　　　.SheetsInNewWorkbook = 1
　　End With
　　Set NewBook = Workbooks.Add
　　NewBook.Sheets(1).Name = "z"
　　With NewBook
　　　　For Each sh In AcBook.Sheets
　　　　　　If TypeOf sh Is Worksheet Then
　　　　　　　　Set NewSh = .Sheets.Add(After:=.Sheets(.Sheets.Count))
　　　　　　　　sh.Cells.Copy NewSh.Range("A1")
　　　　　　　　.Sheets(.Sheets.Count).Name = sh.Name
　　　　　　ElseIf TypeOf sh Is Chart Then
　　　　　　　　sh.Copy After:=NewBook.Sheets(.Sheets.Count)
　　　　　　　　.Sheets(.Sheets.Count).Name = sh.Name
　　　　　　End If
　　　　Next
　　End With
　　With Application
　　　.DisplayAlerts = False
　　　 NewBook.Sheets(1).Delete
　　　.DisplayAlerts = True
　　End With
　　'
　　NewBook.SaveAs "$" & sFn
　　Workbooks("$" & sFn).Close True
　　AcBook.Sheets(1).Select
　　AcBook.Close False
　　Name myPath & sFn As myPath & "$tmp" & ext
　　Name myPath & "$" & sFn As myPath & sFn
　　Name myPath & "$tmp" & ext As myPath & "$" & sFn
　　Set NewBook = Nothing
　　Set AcBook = Nothing
　 '設定を戻す
　　With Application
　　　　.Calculation = xlCalculationAutomatic
　　　　.SheetsInNewWorkbook = shCnt
　　End With
End Sub