VBA学习笔记（一）：自动添加代码&VBA修改注册表

一、以下代码是通过Auto_Open事件，自动向ThisWorkbook里添加VBA代码：

Private Sub Auto_Open()
Call AddCodeToThisWorkbook
MsgBox ("This is Auto_Open Sub !")
End Sub
Private Sub AddCodeToThisWorkbook()
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
.InsertLines 1, "Private Sub Workbook_open()"
.InsertLines 2, "   MsgBox (""This is Workbook_Open Sub !"")"
.InsertLines 3, "End Sub"
End With
End Sub

二、以下代码是通过VBA修改注册表：

Sub ChangeSettings()
Dim Fso
Dim RegKey_User_AcsVm As String
Dim RegKey_User_Level As String
Dim RegKey_Mach_AcsVm As String
Dim RegKey_Mach_Level As String
Dim RegVal_User_AcsVm As Variant
Dim RegVal_User_Level As Variant
Dim RegVal_Mach_AcsVm As Variant
Dim RegVal_Mach_Level As Variant
Dim ExcelVersion As String

On Error Resume Next

ExcelVersion = Application.Version
Set Fso = CreateObject("Scripting.FileSystemObject")

RegKey_User_AcsVm = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & ExcelVersion & "\Excel\Security\AccessVBOM"
RegKey_User_Level = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & ExcelVersion & "\Excel\Security\Level"
RegKey_Mach_AcsVm = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & ExcelVersion & "\Excel\Security\AccessVBOM"
RegKey_Mach_Level = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & ExcelVersion & "\Excel\Security\Level"

Value_User_AcsVm = 1
Value_User_Level = 1
Value_Mach_AcsVm = 1
Value_Mach_Level = 1
Call ModReg(RegKey_User_AcsVm, Value_User_AcsVm, "REG_DWORD")
Call ModReg(RegKey_User_Level, Value_User_Level, "REG_DWORD")
Call ModReg(RegKey_Mach_AcsVm, Value_Mach_AcsVm, "REG_DWORD")
Call ModReg(RegKey_Mach_Level, Value_Mach_Level, "REG_DWORD")
End Sub
Sub ModReg(RegKey As String, Value As Variant, ValueType As String)
Dim oWshell
Set oWshell = CreateObject("WScript.Shell")
If ValueType = "" Then
oWshell.RegWrite RegKey, Value
Else
oWshell.RegWrite RegKey, Value, ValueType
End If
Set oWshell = Nothing
End Sub

三、以下函数用来判断一个工作簿中是否存在指定的Sheet名：

Function SheetIsExist(WBookName As String,WSheetName As String) As Boolean
Dim Tmp_WSheet As Worksheet
For Each Tmp_WSheet In Workbooks(WBookName).Worksheets
If UCase(Tmp_WSheet.Name) = UCase(WSheetName) Then
SheetIsExist = True
Exit Function
End If
Next Tmp_WSheet
SheetIsExist = False
End Function

以下为调用SheetIsExist函数的示例：

Sub Example01()
'开始计时
begin = Timer
'禁止刷屏
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'记录当前文件名
Dim CurFileName As String
CurFileName = Sheets("Sheet1").[A1].Parent.Parent.Name
If SheetIsExist(CurFileName, "Sheet2") Then
Worksheets("Sheet2").Delete
End If
If SheetIsExist(CurFileName, "Sheet3") Then
Worksheets("Sheet3").Delete
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True
over = Timer
MsgBox ("已运行完成！共运行" & over - begin & "s")
End Sub