用VBA宏自動改變Excel宏安全級别設…

用VBA宏自動改變Excel宏安全級别設定

Option Explicit

Sub SetExcelVBA()

'改變Excel的安全級别

'使用Wscript，FileSystemObject，建立txt檔案，系統資料庫操作，VBS檔案自我删除，改變Excel檔案讀寫屬性等

Dim WSH As Object, ret As String, regStr As String

Dim strFullname As String, strVBS As String

Dim tf, fso, RetVal

'本程式僅适用于Excel 2003(11.0)，如果目前版本不是2003則退出

If Application.Version <> "11.0" Then MsgBox "本代碼僅在 Excel 2003 下可使用! ", vbExclamation, "提示": Exit Sub

strFullname = ThisWorkbook.FullName '取得目前工作薄的全名

strVBS = Replace(UCase(strFullname), ".XLS", ".vbs") 'temp檔案VBS的檔案名

Set WSH = CreateObject("Wscript.Shell") '建立Wscript對象

Err.Clear

On Error Resume Next

regStr = "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Security\Level" '系統資料庫中Excel vba安全級别位置

ret = WSH.RegRead(regStr) '讀取目前安全級别

If Err.Number <> 0 Then

   '判斷讀取是否成功

   MsgBox "從系統資料庫讀取目前Excel VBA安全級别設定失敗，本程式将退出! ", vbExclamation, "提示"

   Exit Sub

Else

'如果目前Excel VBA安全級别不為“低”,則設定為“低”,值1-4分别對應：低，中，高，非常高

If Val(ret) <> 1 Then ret = WSH.RegWrite(regStr, "1", "REG_DWORD")

End If

Set fso = CreateObject("Scripting.FileSystemObject")

Set tf = fso.CreateTextFile(strVBS, True) '建立temp檔案VBS檔案

With tf

    '寫入VBS檔案内容

    .WriteLine ("Dim oExcel,fso,delme")

    .WriteLine ("Set fso = CreateObject(""Scripting.FileSystemObject"")")

    .WriteLine ("Set oExcel = CreateObject(""excel.application"")")

    .WriteLine ("oExcel.Workbooks.Open " & Chr(34) & strFullname & Chr(34))

    .WriteLine ("oExcel.Visible=true")

    .WriteLine ("Set oExcel = Nothing")

    .WriteLine ("delme = fso.DeleteFile(" & Chr(34) & strVBS & Chr(34) & ")")

    .Close

End With

With ThisWorkbook

    '将目前檔案屬性設定為“隻讀”，以友善重新打開

    .ChangeFileAccess Mode:=xlReadOnly

    .Saved = True

End With

RetVal = WSH.Run(Chr(34) & strVBS & Chr(34), 1, True) '運作剛剛建立的VBS檔案，新啟動一個Excel程式

Application.Quit '退出目前Excel

Set WSH = Nothing

Set fso = Nothing

End Sub