Automatically add `Option Private Module` to all modules in VBA

前端 未结 2 925
南旧
南旧 2020-12-09 14:07

Is there a way automatically to add Option Private Module to all modules in VBA?

Something like the automatic adding of Option explicit whe

相关标签:
2条回答
  • 2020-12-09 14:24

    This should get you most of the way there, and this example works for all open, unprotected projects. If you need to modify protected projects, just unprotect them first.

    Remember that you'll need to explicitly save changes to any add-ins.

    See the inline comments for the rationale behind various checks

    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
    

    Edit from OP(@vityata): I have decided to add to your answer my updated one (I hope you do not mind). It is with late binding, thus no libraries are needed:

    '---------------------------------------------------------------------------------------
    ' 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
    
    0 讨论(0)
  • 2020-12-09 14:31

    Took me a little longer to modify exisitng code of mine, you could try the following code below to repalce all places of "Option Explicit" with "Option Private Module".

    Code

    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
    
    0 讨论(0)
提交回复
热议问题