- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
20#
發表於 2010-12-25 10:24
| 只看該作者
回復 19# 周大偉
1.將程式碼貼於 ThisWorkbook, 專案的屬性->保護 勾選鎖定專案, 輸入密碼
2.活頁簿另存檔案指令 -> 工具-> 一般選項 輸入活頁簿保護密碼- Option Explicit
- Private Const 密碼 = "1234"
- Private Const 字體顏色 = 1
- Private Const 保護色 = 2 '可自行修改
- Dim Answer$
- Private Sub Workbook_Open()
- Sheets_Protect
- Answer_Pass
- End Sub
- Private Sub Workbook_BeforeClose(Cancel As Boolean)
- Sheets_Protect
- Save
- End Sub
- Private Sub Workbook_SheetActivate(ByVal Sh As Object)
- Answer_Pass
- End Sub
- Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
- My_UnProtect (IIf(Answer = 密碼, True, False))
- End Sub
- Private Sub Sheets_Protect()
- Dim Sh As Worksheet
- For Each Sh In Sheets
- With Sh
- .Unprotect 密碼
- .Cells.Font.ColorIndex = 保護色
- .Cells.Interior.ColorIndex = .Cells.Font.ColorIndex
- .EnableSelection = xlNoSelection
- .Protect PassWord:=密碼, DrawingObjects:=True
- End With
- Next
- End Sub
- Private Sub My_UnProtect(Y As Boolean)
- Application.ScreenUpdating = False
- With ActiveSheet
- .Unprotect 密碼
- If Y = True Then
- .Cells.Font.ColorIndex = 字體顏色
- .Cells.Interior.ColorIndex = xlNone
- Application.CommandBars.FindControl(ID:=30029).Enabled = True
- Else
- .Cells.Font.ColorIndex = 保護色
- .Cells.Interior.ColorIndex = .Cells.Font.ColorIndex
- .EnableSelection = xlNoSelection
- .Protect PassWord:=密碼, DrawingObjects:=True
- Application.CommandBars.FindControl(ID:=30029).Enabled = False
- End If
- End With
- Application.ScreenUpdating = True
- End Sub
- Private Sub Answer_Pass()
- If Answer <> 密碼 Then
- If InputBox("密碼??", "輸入密碼") = 密碼 Then Answer = 密碼
- End If
- My_UnProtect (IIf(Answer = 密碼, True, False))
- End Sub
|
|
發表於 2010-12-26 18:23
| 
