VBA学习笔记(11)-经典代码之 (Visio中升级代码)
Option Explicit Private Function add() On Error GoTo ErrHandler Dim filePath As String, fileName As String filePath = Application.ActiveDocument.Path fileName = filePath + "hello.bas" Visio.Application.Vbe.ActiveVBproject.VBComponents.Import (fileName) ‘Shell "cmd /c del " & fileName, vbHide Exit Function ErrHandler: MsgBox Err.Description End Function Private Function del() On Error GoTo ErrHandler Dim modName As String modName = "hello" If (check(modName) = 1) Then Visio.Application.Vbe.ActiveVBproject.VBComponents.Remove Visio.Application.Vbe.ActiveVBproject.VBComponents(modName) End If Exit Function ErrHandler: MsgBox Err.Description End Function Public Function call_ext() Call hello.hello End Function Function check(ByVal modName As String) As Long On Error GoTo ErrHandler Dim i check = 0 ‘MsgBox Visio.Application.Vbe.ActiveVBproject.VBComponents.Count For i = 1 To Visio.Application.Vbe.ActiveVBproject.VBComponents.Count ‘MsgBox Visio.Application.Vbe.ActiveVBproject.VBComponents(i).Name If (Visio.Application.Vbe.ActiveVBproject.VBComponents(i).Name = modName) Then check = 1 End If Next i Exit Function ErrHandler: MsgBox Err.Description End Function Function AddCode(ByVal blockName As String, ByVal codeLine As Integer, ByVal codeString As String) On Error GoTo ErrHandler ‘insert ‘With Visio.Application.Vbe.ActiveVBproject.VBComponents("update").CodeModule ‘ .InsertLines codeLine, codeString ‘End With ‘replace Visio.Application.Vbe.ActiveVBproject.VBComponents(blockName).CodeModule.ReplaceLine codeLine, codeString Exit Function ErrHandler: MsgBox Err.Description End Function ‘Sub test() ‘ Call AddCode("update", 2, "modName = ""hello""") ‘End Sub Public Sub update() Call del Call add ‘Call call_ext MsgBox "Update Done" End Sub
包括删除和增加模块;
当然也可以备份:
Option Explicit Public Sub backup() On Error GoTo ErrHandler Dim filePath As String, fileName As String filePath = Application.ActiveDocument.Path fileName = filePath + "hello.bas" Visio.Application.Vbe.ActiveVBproject.VBComponents("hello").Export (fileName) MsgBox "Backup done" Exit Sub ErrHandler: MsgBox Err.Description End Sub
郑重声明:本站内容如果来自互联网及其他传播媒体,其版权均属原媒体及文章作者所有。转载目的在于传递更多信息及用于网络分享,并不代表本站赞同其观点和对其真实性负责,也不构成任何其他建议。