excel vba 获取当前文件名_VBA实战技巧14： 生成删除宏代码的工作簿

学习Excel技术，关注微信公众号：

excelperfect

有时候，我们在借助于宏快速整理和分析数据、创建报表后，需要将工作簿分发给其他人，但不想将工作簿中的宏一并发送，或者没有必要在发送的工作簿中带有宏，或者对方不接收带有宏的工作簿。这样，就需要我们在发送工作簿前将所有的宏代码清除。

下面的代码将生成不含宏代码的当前工作簿的副本。

'复制当前工作簿'新工作簿不含有任何宏代码Sub CopyActiveWorkbook()    Dim varName As Variant    Dim wb As Workbook    Dim vbc As Object      '询问存储当前文件的位置    varName = Application.GetSaveAsFilename( _        InitialFileName:="副本_" & ThisWorkbook.Name, _        FileFilter:="Microsoft Excel工作簿(*.xls),*.xls")       If TypeName(varName) = "Boolean" Then       '选择取消,退出程序        Exit Sub    End If      '确保访问的VBA工程存在    On Error Resume Next    Set vbc =ActiveWorkbook.VBProject.VBComponents(1)    On Error GoTo err_h    If vbc Is Nothing Then       '拒绝访问,要求用户开启        MsgBox "不允许访问VB工程." & _            vbNewLine & "请设置信任对VBA工程对象模型的访问."        Exit Sub    End If       Set vbc = Nothing      '以用户指定的文件名保存工作簿    ActiveWorkbook.SaveCopyAs varName      '打开工作簿(关闭信息提示)    Application.EnableEvents = False    Set wb = Workbooks.Open(varName)    Application.EnableEvents = True       For Each vbc In wb.VBProject.VBComponents        Select Case vbc.Type          '标准模块,vbext_ct_StdModule          '类模块,vbext_ct_ClassModule          '用户窗体,vbext_ct_MSForm          Case 1, 2, 3            wb.VBProject.VBComponents.Removevbc          'vbext_ct_ActiveXDesigner          'vbext_ct_Document          Case Else            With vbc.CodeModule              .DeleteLines 1, .CountOfLines            End With        End Select    Next vbc      '保存工作簿    wb.Save   '关闭    wb.Close SaveChanges:=False       MsgBox Prompt:="完成!"    Exit Sub   err_h:    MsgBox "错误 " & Err.Number & ", " &Err.Description, vbCriticalEnd Sub

代码中使用工作簿的VBProject对象的VBComponents集合，遍历每一项，根据组件的类型，删除其内容或移除该项。

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。

欢迎到知识星球：完美Excel社群，进行技术交流和提问，获取更多电子资料。