自动将“Option Private Module”添加到VBA中的所有模块

Question

自动将“Option Private Module”添加到VBA中的所有模块

4

有没有自动将

Option Private Module添加到VBA中的所有模块的方法？
像在Extras>Option>编辑器中标记变量声明复选框时自动添加Option explicit一样？
因为手动遍历所有模块并编写代码似乎是唯一的选择。
子问题：
如果您必须将Option Private Module添加到10个应用程序的所有模块中，您会怎么做？
起初，我考虑使用简单的替换方法，并将Option Explicit替换为Option Explicit ^p Option Private Module，但它也会替换类中的选项，我还需要从那里删除它。
有什么好的建议可以节省30分钟吗？

- Vityata

如果您使用所有要替换的模块构建一个数组，那么在使用替换时，您可以在执行替换之前检查当前模块是否在该数组中。 - Shai Rado

@ShaiRado，我没有理解你的想法。我所指的替换是在VBEditor中按下Ctrl+H时出现的那个。 - Vityata

我之前提到使用VBProject编辑器构建一些代码，但在你的情况下，手动操作可能更快。 - Shai Rado

在网上寻找VBA代码，以导出VBA模块，修改一点以排除您想要替换的代码。删除导出的类，然后进行替换，然后使用类似的代码从创建的文件中导入。但不是一个复选框解决方案，在30分钟内可能完成，Ron在这里有一个起点http://www.rondebruin.nl/win/s9/win002.htm - Nathan_Sav

@Vityata，我修改我的现有代码花费的时间比我想象的要长一些，但是我已经得到了下面的东西（不到30分钟，只有29分钟 :)）。 - Shai Rado

2个回答

3

修改现有代码花费了我一点时间，你可以尝试使用以下代码来将所有的"Option Explicit"替换为"Option Private Module"。

代码

Option Explicit

Sub ReplaceOptionExplicitInModules()

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim i As Long

' loop though all open projects
For Each VBProj In Application.VBE.VBProjects

    If VBProj.Protection = vbext_pp_none Then

        ' loop through all modules, worksheets and other objects in VB Project
        For Each VBComp In VBProj.VBComponents

            If VBComp.Type <> vbext_ct_ClassModule Then  ' <-- check if module type is not class (to replace also on sheet and workbook events)
                Set CodeMod = VBComp.CodeModule

                ' loop through all code lines inside current module
                For i = 1 To CodeMod.CountOfLines
                    If Len(CodeMod.Lines(i, 1)) > 0 Then
                        ' if line contents is "Option Explicit*" 
                        If CodeMod.Lines(i, 1) Like "Option Explicit*" Then
                            CodeMod.ReplaceLine i, "Option Private Module"
                        End If
                    End If
                Next i
            End If
        Next VBComp
    End If
Next VBProj

End Sub

- Shai Rado

听起来很有趣，谢谢。我有一个小建议 - 我需要在每个模块中都加上 Option Private Module，就在 "Option Explicit" 下面，我的最初想法是用 "Option Explicit ^p Option Private Module" 替换 "Option Explicit"。 - Vityata

给我30分钟。 - Shai Rado

1

@ShaiRado，你在使用没有通配符的“Like”。如果同一行上有注释，或者在“Option”和“Explicit”之间和/或之后有换行符，会发生什么？ - ThunderFrame

1

如果您正在遍历行，只需循环直到“CountOfDeclarationLines”即可节省大量处理时间。 - ThunderFrame

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- ThunderFrame · Accepted Answer

这应该可以帮助你完成大部分工作，这个示例适用于所有开放的、未受保护的项目。如果您需要修改受保护的项目，请先取消保护。

请记住，您需要显式保存对任何插件的更改。

请查看内联注释以了解各种检查背后的原理。

Sub Foo()

  'Add a reference to Visual Basic for Applications Extensibility
  Dim proj As VBIDE.VBProject
  Dim comp As VBIDE.VBComponent
  For Each proj In Application.VBE.VBProjects

    'Check the project isn't protected
    If proj.Protection = vbext_pp_none Then

      For Each comp In proj.VBComponents
        'Check we're working with a standard module
        If comp.Type = vbext_ct_StdModule Then
          'TODO: Check that Option Private Module doesn't already exist
          comp.CodeModule.InsertLines 1, "Option Private Module"
        End If

      Next comp

    End If

  Next proj

End Sub

来自原作者(@vityata)的修改：我决定将我的更新答案添加到您的答案中（希望您不介意）。它使用延迟绑定，因此不需要任何库：

'---------------------------------------------------------------------------------------
' Method : AddOptionPrivate
' Author : stackoverflow.com
' Date   : 12.01.2017
' Purpose: Checking for "Option Private Mod~" up to line 5, if not found we add it in
'           every module
'---------------------------------------------------------------------------------------
Sub AddOptionPrivate()

    Const UP_TO_LINE = 5
    Const PRIVATE_MODULE = "Option Private Module"

    Dim objXL               As Object

    Dim objPro              As Object
    Dim objComp             As Variant
    Dim strText             As String

    Set objXL = GetObject(, "Excel.Application")
    Set objPro = objXL.ActiveWorkbook.VBProject

    For Each objComp In objPro.VBComponents
        If objComp.Type = 1 Then
            strText = objComp.CodeModule.Lines(1, UP_TO_LINE)

            If InStr(1, strText, PRIVATE_MODULE) = 0 Then
                objComp.CodeModule.InsertLines 2, PRIVATE_MODULE
            End If

        End If
    Next objComp

End Sub