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

2015-04-13 17:20 阅读 140 次 评论关闭

'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
For 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

版权声明:本文著作权归原作者所有,欢迎分享本文,谢谢支持!
转载请注明:Excel VBA高级编程:文件打开时自动添加宏代码 | 猎微网

评论已关闭!