Excel VBA高级编程:文件打开时自动添加宏代码

Excel :文件打开时自动添加宏代码

'ThisWokbook................................
Private pevt As glass

Private Sub Workbook_AddinInstall()
Set pevt = New glass
End Sub

Private Sub Workbook_Open()
Set pevt = New glass
End Sub

'Glass Module ......................................................
Public WithEvents xlapp As Excel.Application

Private Sub Class_Initialize()
Set xlapp = Application

End Sub

Private Sub xlapp_NewWorkbook(ByVal Wb As Workbook)
Msg = MsgBox("新档案是否加入宏", vbYesNo, "提示")
If Msg = vbYes Then
  With Wb.VBProject.VBComponents(2).CodeModule
      .InsertLines 1, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
      .InsertLines 2, "msgbox " & """" & "OK" & """"
      .InsertLines 3, "end sub"
  End With
End If
End Sub

Private Sub xlapp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
'删除宏警告
If Wb.Name <> "Booo.xla" Then
Msg = MsgBox(Wb.Name & "档案将关闭前是否删除所有宏", vbYesNo, "警告")
If Msg = vbYes Then
    ActiveWorkbook.Activate
        i = 1 To ActiveWorkbook.VBProject.VBComponents.Count
             ActiveWorkbook.VBProject. _
                VBComponents(i).CodeModule.DeleteLines 1, _
                ActiveWorkbook.VBProject. _
                VBComponents(i).CodeModule.CountOfLines
        Next i
End If
End If
End Sub

Private Sub xlapp_WorkbookOpen(ByVal Wb As Workbook)
If Wb.Name <> "Booo.xla" Then
  Msg = MsgBox(Wb.Name & "开启後是否加入宏", vbYesNo, "提示")
    If Msg = vbYes Then
        With Wb.VBProject.VBComponents(2).CodeModule
              .InsertLines 1, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
              .InsertLines 2, "msgbox " & """" & "OooooK" & """"
              .InsertLines 3, "end sub"
        End With
    End If
End If
End Sub