Ｐａｇｅ 54 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼マクロの削除（整理） haru 02/9/4(水) 10:24 ┗Re:マクロの削除（整理） ぴかる 02/9/4(水) 11:00 ┗Re:マクロの削除（整理） haru 02/9/4(水) 13:17 ┗Re:マクロの削除（整理） ぴかる 02/9/4(水) 15:03 ┗Re:マクロの削除（整理） りん 02/9/4(水) 17:49 ┗ちなみにマクロ名の列挙は 大那 02/9/5(木) 15:13 ┣Re:ちなみにマクロ名の列挙は コロスケ 02/9/6(金) 10:47 ┃ ┗Re:ちなみにマクロ名の列挙は 大那 02/9/6(金) 11:04 ┗Re:ちなみにマクロ名の列挙は りん 02/9/8(日) 0:56 ┣Re:ちなみにマクロ名の列挙は 大那 02/9/9(月) 10:27 ┗Re:ちなみにマクロ名の列挙は haru 02/9/9(月) 15:40 ┣Re:ちなみにマクロ名の列挙は コロスケ 02/9/9(月) 15:48 ┗Re:ちなみにマクロ名の列挙は コロスケ 02/9/9(月) 16:38 ┗Re:ちなみにマクロ名の列挙は haru 02/9/10(火) 9:21 ─────────────────────────────────────── ■題名 ： マクロの削除（整理） ■名前 ： haru ■日付 ： 02/9/4(水) 10:24 -------------------------------------------------------------------------
| マクロの記録をすると、自動的に、モジュールが追加されそこに macro1,macro2,macro3・・・という風に追加されますが、 これらのマクロ名のものを削除したいのですが。 またその結果、モジュール内が空になるか、またはコメントだけ になってしまったら、モジュールごと削除したいのですが。 以上をあるブックの全てもモジュールに対してやりたいのですが、 可能でしょうか？ 更にできれば、あるフォルダ内の全てのブックに対しても実行し たいのですが。 よろしくお願いします。 |
| haruさん、こんにちは。 Ｖ３にて標準モジュールの削除方法を教えていただきました。 よろしかったら、参考にして下さい。 http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=ntr;tree=10169;id=Excel |
| ▼ぴかる さん： こんにちは。ありがとうございます。 >Ｖ３にて標準モジュールの削除方法を教えていただきました。 >よろしかったら、参考にして下さい。 >http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=ntr;tree=10169;id=Excel 一応投稿前に拝見いたしました。 モジュール内に例えば、次のようなマクロがあったとき、 Sub Macro1() ' ' Macro1 Macro ' ﾏｸﾛ記録日 : 2002/9/4 ﾕｰｻﾞｰ名 : ' ' '（記録内容） End Sub sub test() '自分で記入したコード End Sub Macro1だけ削除したいのですが、可能ですか？ 大きな違いは、この辺です。 よろしくお願いします。 モジュール内がMacro1だけなら、これを削除した後、モジュール そのものも削除したいのですが。 |
| haruさん、こんにちは >Sub Macro1() >' >' Macro1 Macro >' ﾏｸﾛ記録日 : 2002/9/4 ﾕｰｻﾞｰ名 : >' > >' > '（記録内容） >End Sub > >sub test() > '自分で記入したコード >End Sub > > Macro1だけ削除したいのですが、可能ですか？ > 大きな違いは、この辺です。 > よろしくお願いします。 > > モジュール内がMacro1だけなら、これを削除した後、モジュール >そのものも削除したいのですが。 ごめんなさい。私には無理です。どなたかお助けを・・・。 |
| haruさん、ぴかるさん、こんにちは >> Macro1だけ削除したいのですが、可能ですか？ Macro1からMacro100まで削除します。 Sub Main() Application.ScreenUpdating = False '実行用 Dim ws As Worksheet, wb As Workbook 'ログ残す Set ws = Workbooks.Add.Worksheets(1) ws.Cells(1, 1).Value = "ブック" ws.Cells(1, 2).Value = "Macro削除" '指定するフォルダ名 Ipath$ = "D:\MacroDelete" '最初のファイルチェック Ifile$ = Dir(Ipath$ + "\*.xls") Rmax& = 1 Do If Ifile$ = "" Then Exit Do Rmax& = Rmax& + 1 ws.Cells(Rmax&, 1).Value = Ifile$ Ifile$ = Dir '継続 Loop ' For RR& = 2 To Rmax& Ifile$ = ws.Cells(RR&, 1).Value Set wb = Workbooks.Open(FileName:=Ipath$ + "\" + Ifile$) Application.StatusBar = wb.Name '関数呼び出し ws.Cells(RR&, 2).Value = RemoveSubs(wb) With wb .Close SaveChanges:=True End With Set wb = Nothing Next ' ws.Parent.Saved = True Set ws = Nothing With Application .ScreenUpdating = True .StatusBar = False End With End Sub ' Private Function RemoveSubs(wb As Workbook) As Long '削除したSubの数を返す関数 Dim vbcs As Object, vbc As Object Dim LL&, L1&, L2&, Lflg As Boolean Set vbcs = wb.VBProject.VBComponents LL& = 0 For Each vbc In vbcs If vbc.Type = 1 Then ' GoSub LineChk: 'モジュールが空になっていたら削除 If Lflg = True Then vbcs.Remove vbc 'モジュール削除 End If End If Next Set vbcs = Nothing: Set vbc = Nothing RemoveSubs = LL& Exit Function '////////// LineChk: 'Module100までチェック For NN& = 1 To 100 L1& = 0: L2& = 0 With vbc.CodeModule On Error Resume Next L1& = .ProcStartLine("Macro" & NN&, vbext_pk_Proc) L2& = .ProcCountLines("Macro" & NN&, vbext_pk_Proc) On Error GoTo 0 If L1& > 0 Then .DeleteLines L1&, L2& LL& = LL& + 1 End If If .CountofLines = 0 Then Exit For End With Next Lflg = (vbc.CodeModule.CountofLines = 0) 'コメントのみある場合（SubやFunction宣言がない場合）のチェック If Lflg = False Then With vbc.CodeModule If .Find("Sub", 1, 1, .CountofLines, 1) = False Then If .Find("Function", 1, 1, .CountofLines, 1) = False Then .DeleteLines 1, .CountofLines LL& = LL& + 1 Lflg = True End If End If End With End If Return End Function こんな感じです。 |
| りんさん、haruさん、ぴかるさん、こんにちは このマクロの削除の問答、 とても興味深いものでしたので拝見させていただいたのですが、 こんなことまでできちゃうんですね（＾＾； ちなみに、指定したmoduleの中にあるマクロの名前の一覧などは 作成することができるのでしょうか？ |
| ▼大那 さん： こんにちは。ActiveWorkbookのModule,Functionの名前を抜き出してみました。 Microsoft Visual Basic for Applications Extensibility 5.3 に参照設定をしてください。 ではー♪ Sub Test() Debug.Print "Subは" Call GetProcAndFuncName("Sub") 'Subを書き出し Debug.Print "Functionは" Call GetProcAndFuncName("Function") 'Functionを書き出し End Sub '----------------------------------------------------------- Sub GetProcAndFuncName(ByVal strSubFunc As String) Dim objComp As Object, strBuf As String, pn, Ret Dim intIdx As Long, lngSt As Long, lngEd As Long, intLenStr As Long intLenStr = Len(strSubFunc) + 1 For Each objComp In Application.ActiveWorkbook.VBProject.VBComponents strBuf = objComp.CodeModule.Lines(1, objComp.CodeModule.CountOfLines) intIdx = InStr(strBuf, strSubFunc) If intIdx <> 0 Then Do Until intIdx = 0 If Mid(strBuf, intIdx + intLenStr, 1) <> vbLf Then lngSt = intIdx + intLenStr lngEd = InStr(intIdx + intLenStr, strBuf, "(") If lngSt = 0 Or lngEd = 0 Then Exit Do pn = Mid(strBuf, lngSt, lngEd - lngSt) On Error Resume Next Ret = IsNumeric(objComp.CodeModule.ProcStartLine(pn, vbext_pk_Proc)) If Ret Then Debug.Print Mid(strBuf, lngSt, lngEd - lngSt) Ret = False End If intIdx = InStr(intIdx + 1, strBuf, strSubFunc, 1) Loop End If Next End Sub |
| コロスケ さん こんにちは。(_ _) おー。こんなことまでできちゃうのですね。 すごいです。 これで、モジュール＆マクロ一覧が作成できますー。 ありがとうございましたー（＾＾ |
| 大那 さん、こんばんは。 >ちなみに、指定したmoduleの中にあるマクロの名前の一覧などは >作成することができるのでしょうか？ haruさんへの回答をちょっと修正して。 Sub Main() With Application .ScreenUpdating = False .EnableEvents = False End With '実行用 Dim wb1 As Workbook, wb2 As Workbook '一覧作成 '指定するファイル Ifile$ = Application.GetOpenFilename If Ifile$ = "FALSE" Then MsgBox "ファイルを指定", vbExclamation, "中断" Else Set wb1 = Workbooks.Add With wb1.Worksheets(1) .Cells(1, 1).Value = "ブック" .Cells(1, 2).Value = "モジュール" .Cells(1, 3).Value = "マクロ" .Cells.ColumnWidth = 30 End With ' Set wb2 = Workbooks.Open(FileName:=Ifile$) '実働部分呼び出し CountSubs wb2, wb1.Worksheets(1) '解放 With wb2 .Saved = True .Close End With Set wb2 = Nothing End If ' wb1.Saved = True Set wb1 = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub ' Private Sub CountSubs(wb As Workbook, ws As Worksheet) '削除したSubの数を返す関数 Dim vbcs As Object, vbc As Object Dim LL&, L1&, L2&, Lflg As Boolean, RR&, NN$ Set vbcs = wb.VBProject.VBComponents ' RR& = 1 For Each vbc In vbcs With vbc.CodeModule If .CountOfLines > 0 Then L1& = 1 Do NN$ = "" On Error Resume Next NN$ = .ProcOfLine(L1&, 0) On Error GoTo 0 If NN$ = "" Then L1& = L1& + 1 Else RR& = RR& + 1 With ws .Cells(RR&, 1).Value = wb.Name .Cells(RR&, 2).Value = vbc.Name .Cells(RR&, 3).Value = NN$ End With L2& = .ProcCountLines(NN$, 0) L1& = L1& + L2& End If Loop While L1& <= .CountOfLines End If End With Next Set vbcs = Nothing: Set vbc = Nothing End Sub 解決ずみのようですが、こんな方法もあります。 ＃コロスケさん、ありがとうございました。 |
| りん さん、こんにちは。 さらなる、ご回答ありがとうございます（＾＾ 私もコロスケさんのロジックを参考に いろいろと改造したりして勉強しているところです。 りんさんのロジックもとても参考になります（＾＾ どの質問に対しても、答えは一つじゃないと思いますし、 一つの答えが知れればそれでいい。というのではなく、 みなさんのご好意による回答をそれぞれ拝見し、 それらを応用し、自分なりに活用できるよう心がけていきます。 まだ、自分の使ったことの無い関数なども知ることができ、 使い方も知ることができるので、とても勉強になります。 りんさん、コロスケさんありがとうございます！ |
| ▼りん さん、コロスケさん、大那 さん、こんにちは。 ありがとうございます。 >>ちなみに、指定したmoduleの中にあるマクロの名前の一覧などは >>作成することができるのでしょうか？ 逆に一覧を見ながら、作成された一覧のカーソルのあるセルのマ クロ、モジュールを削除とか、選択部分の複数のマクロ等を削除と いうことができれば、更に素晴らしいのですが、可能でしょうか？ よろしくお願いします。 |
| ▼haru さん： こんにちは。できますよ。 削除方法はりんさんが書いていらっしゃるので、一覧を最初に作って それから、プロジェクトを見に行けば可能だと思います。 でも、XPでは設定によりProjectへのアクセス自体制限されることもあるので VBEで操作したほうが確実なような気がします...。 |
| ▼haru さん： ▼haru さん： 一覧表作成までを書いてみました。 Microsoft Visual Basic for Applications Extensibility 5.3 に参照設定をしてください。 削除は、時間切れなので、りんさんのカキコを参考にしてお考え下さいませ。 ではー♪ Dim x As Long Dim aList() Sub GetVbProj() Dim oVBC As VBIDE.VBComponent Dim Wb As Workbook x = 2 For Each Wb In Workbooks For Each oVBC In Workbooks(Wb.Name).VBProject.VBComponents If Workbooks(Wb.Name).VBProject.Protection = vbext_pp_none Then Call GetCodeRoutines(Wb.Name, oVBC.Name) End If Next Next With Sheets.Add .[A1].Resize(, 3).Value = Array("ブック名", "モジュール名", "プロシージャ名") .[A2].Resize(UBound(aList, 2), UBound(aList, 1)).Value = _ Application.Transpose(aList) .Columns("A:C").Columns.AutoFit End With End Sub Private Sub GetCodeRoutines(wbk As String, VBComp As String) Dim VBCodeMod As CodeModule Dim StartLine As Long On Error Resume Next Set VBCodeMod = Workbooks(wbk).VBProject.VBComponents(VBComp).CodeModule With VBCodeMod StartLine = .CountOfDeclarationLines + 1 Do Until StartLine >= .CountOfLines ReDim Preserve aList(1 To 3, 1 To x - 1) aList(1, x - 1) = wbk aList(2, x - 1) = VBComp aList(3, x - 1) = .ProcOfLine(StartLine, vbext_pk_Proc) x = x + 1 StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, _ vbext_pk_Proc), vbext_pk_Proc) If Err Then Exit Sub Loop End With Set VBCodeMod = Nothing End Sub |
| ▼コロスケ さん： こんにちは。ありがとうございます。 >削除は、時間切れなので、りんさんのカキコを参考にしてお考え下さいませ。 わかりました。自分でやってみます。 その中で、不明な所があれば、また質問いたします。 |