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

 

转载于:https://www.cnblogs.com/xiyoulhj/p/4417556.html