可以删除Word中的空宏 - 还是阻止它们?

时间:2018-01-22 21:17:02

标签: vba ms-word word-vba

我正在为执行相同功能的不同用户(但在单个模板中使用不同的结果)创建一系列模板和伴随宏和样式(嵌入在模板中)。

例如,每个模板都会有一系列宏来改变样式中的字体颜色,在默认黑色和各种颜色之间随意翻转,作为校对格式的视觉辅助。

在另一个示例中,每个模板都具有类似重叠的样式和样式名称和宏。但是"问题"例如,一个模板的样式可能在左边距处有Q,而.5和#34;悬挂缩进,而另一个模板可能会以1&#34的第一行缩进启动Q.并将后续行包装到边距。但两种风格都有相同的名称。模板中的伴随宏也将具有相同的名称。

某些宏将被分配给键盘快捷键,但对于其中许多宏,用户将按Alt + F8进入宏列表或使用文本扩展器命令功能来访问它们(例如,qcol可能会运行宏COLORS_Question_Style_Red,将问题样式更改为红色字体。文本扩展器命令将执行与用户相同的操作:Alt + F8,COLORS_Question_Style_Red,[ENTER]。

一切正常,除非用户忘记她不在基于其中一个模板的文档中,并且她经历了调用宏的过程(例如,使用文本扩展器快捷方式,或按Alt键) + F8,键入宏名称的一部分,然后按ENTER键)。

当然,当Word没有找到这样的宏时,它会假设你想要创建一个宏,它会带你进入当前活动模板的宏编辑器窗口,在那里它创建了一个空宏,您现在可以用代码填写它。有些用户在看到它时会删除空宏,而其他用户只会关闭窗口,保持空宏不变。

如果用户在关闭编辑器窗口时选择保持空宏不变,则下次她经历尝试触发当前无法访问的宏的相同错误步骤时,系统将赢得“#”。 t"困扰她"通过将她拖入编辑器窗口,因为它认为它已找到宏。但结果是它绝对没有任何作用,她最终会意识到她的错误,并根据正确的模板打开或创建一个文档。

这一切都很好和花花公子,除了当她真的想要在正确的模板中使用宏时,现在也存在于"空&#34 ;在Normal模板中的表单,她去运行宏,没有任何反应,因为Normal模板中的空宏胜过当前模板中的真实宏。

此外,如果她尝试在事物处于此状态时将自定义键盘快捷键(在适当的模板中)分配给伪复制宏,则宏甚至不会显示在自定义键盘的宏/命令列表中对话窗口。

我在Google中进行了详尽的搜索,找不到对自动删除空宏的宏代码的单一引用。我搜索的所有内容都会返回点击以删除Excel或Word表格中的空单元格。

是否有人知道可以编写任何代码来解决这个问题?我认为将它包含为Auto_New和Auto_Open宏会很好,并且可以根据需要在编辑会话期间为用户提供按需运行。

或许还有更好的方法。我愿意接受建议。提前谢谢!

更新1/23/18以包括宏窗口的屏幕截图:

enter image description here

1 个答案:

答案 0 :(得分:1)

我倾向于为用户提供一个界面,使他们不太可能遇到问题,例如一系列键盘快捷键或功能区控件。但我怀疑你已经考虑过了。

可以使用VB Extensibility库(Office的一部分)来处理代码模块,但是您必须在工具/参考资料中添加对 Microsoft Visual Basic for Applications Extensibility 5.3 的引用VBA编辑器)。这个对象模型有点挑剔,没有很好的文档记录。我记不起在论坛上曾经见过关于这个特定主题的讨论......

这尚未经过广泛测试,但似乎在我的测试环境中有效。它只搜索Normal.dotm的NewMacros模块,因为这将是您描述的场景中最常见的问题。您需要对其进行调整以搜索其他模板或文档(ActiveDocumentActiveDocument.AttachedTemplate),但我怀疑这对您来说不会有问题。

'Delete procedures that containt only empty lines,
'Sub, Dim, End Sub and comments    
Sub RemoveEmptyMacros()
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.vbComponent
    Dim CodeMod As VBIDE.CodeModule
    Dim ProcKind As VBIDE.vbext_ProcKind

    Dim LineNum As Long
    Dim ProcName As String
    Dim iLineCounter As Long
    Dim iProcStart As Long, iProcNrLines As Long
    Dim sLineContent As String
    Dim isEmpty As Boolean

    'Needed only if you want to log deletions
    Dim Doc As word.Document
    Dim Rng As Range

    'Change this to search something other than Normal.dotm
    Set VBProj = NormalTemplate.VBProject
    Set VBComp = VBProj.vbComponents("NewMacros")
    Set CodeMod = VBComp.CodeModule
    iLineCounter = 0

    'Needed only if you want to log deletions
    Set Doc = ActiveDocument
    Set Rng = Doc.content

    With CodeMod
        'Start after the declaration section
        LineNum = .CountOfDeclarationLines + 1

        'Loop all the procedures by going line-by-line
        Do Until LineNum >= .CountOfLines
            'Assume a procedure is empty, if it's not
            'this will be set to false and nothing happens
            isEmpty = True
            ProcName = .ProcOfLine(LineNum, ProcKind)
            iProcStart = .ProcStartLine(ProcName, ProcKind)
            iProcNrLines = .ProcCountLines(ProcName, ProcKind)

            'Check all lines whether empty, sub, dim, end, comment
            'OR have content
            For iLineCounter = iProcStart To iProcStart + iProcNrLines
                sLineContent = .Lines(iLineCounter, 1)
                If Len(sLineContent) > 0 Then
                    'if there's content, procedure is not empty
                    'leave the FOR loop without deleting
                    If Left(Trim(sLineContent), 1) <> "'" And _
                        Left(Trim(sLineContent), 3) <> "Sub" And _
                        Left(Trim(sLineContent), 3) <> "End" Then
                            isEmpty = False
                            Exit For
                    End If
                End If
            Next

            'Increment line number to start of next procedure
            'for next DO loop
            LineNum = iProcStart + iProcNrLines + 1
            'If you want a list of all procedures in the Immediate Window
            'Debug.Print ProcName

            If isEmpty Then
                'If you want to log a list of the subs that were deleted
                'Rng.Text = ProcName & vbCr
                'Rng.Collapse wdCollapseEnd
                .DeleteLines iProcStart, iProcNrLines
            End If
        Loop
    End With
End Sub

Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
    Select Case ProcKind
        Case vbext_pk_Get
            ProcKindString = "Property Get"
        Case vbext_pk_Let
            ProcKindString = "Property Let"
        Case vbext_pk_Set
            ProcKindString = "Property Set"
        Case vbext_pk_Proc
            ProcKindString = "Sub Or Function"
        Case Else
            ProcKindString = "Unknown Type: " & CStr(ProcKind)
    End Select
End Function