[發問] 今日 日期 可以修改 可以輸入 今日之前 鎖定 無法修改後

帖子: 173
主題: 42
精華: 0
積分: 220
點名: 0
作業系統: win10
軟體版本: Office 365
閱讀權限: 20
性別: 男
註冊時間: 2010-10-13
最後登錄: 2023-10-11

3^#

發表於 2011-12-18 18:29 | 只看該作者

本帖最後由 mycmyc 於 2011-12-18 18:33 編輯

回復 2# GBKEE
謝謝版主回答
目前遇到問題是
目前無法判別  A:A 日期大於系統日期那欄可以修改  其他多鎖定請幫我修正

目的: 用A：A判斷如果是今日日期或 A欄空白整列可以修改可以輸入
         A欄今日之前鎖定那欄整列無法修改後  ，  A：A空白可以輸入
   例如  A8  值日期是今日  那 A8整列可以修改
            A7  值日期是今日之前不能修改  那列鎖定
            A15  值是空白  就可以修改或新增
麻煩你

Public 密碼, Rng As Range
'Public ->變數公用於此專案
Private Sub Auto_Open() '一般 Module中開啟檔案時會自動執行的程序
密碼 = "1234"
With Sheet1 [color=Red]此行我修改 Sheet1 非大大你 Sheet（1）[/color] '指定的工作表
.Activate
.Unprotect 密碼 '取消工作表保
.Cells.Locked = True '儲存格鎖定
.Cells.FormulaHidden = True '儲存格隱藏
Set Rng = .Cells(.UsedRange.Rows.Count + 1, 1)
'Rng 設定已使用範圍第1欄最後的下一個空白儲存格
Rng.Locked = False
Rng.FormulaHidden = False
.Protect 密碼 '工作表設定保護
End With
Rng.Select
End Sub

複製代碼

Private Sub Worksheet_Change(ByVal Target As Range)
If Rng.Value <> Date Then
Unprotect 密碼 '取消工作表保
Cells.Locked = True '儲存格鎖定
Cells.FormulaHidden = True '儲存格隱藏
Rng.Locked = False
Rng.FormulaHidden = False
Protect 密碼 '工作表設定保護
ElseIf Rng.Value = Date Then
Unprotect 密碼 '取消工作表保
End If
End Sub

複製代碼

Book1.rar (17.35 KB)

HI

帖子: 173
主題: 42
精華: 0
積分: 220
點名: 0
作業系統: win10
軟體版本: Office 365
閱讀權限: 20
性別: 男
註冊時間: 2010-10-13
最後登錄: 2023-10-11

4^#

發表於 2011-12-18 18:46 | 只看該作者

GBKEE版主
如果用IF 小於系統日期就鎖定整列
IF＝空白或等於系統日期就不鎖定可以達成嗎

HI

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2011-12-18 18:59 | 只看該作者

回復 4# mycmyc

Private Sub Auto_Open() '一般 Module中開啟檔案時會自動執行的程序
Dim E As Range, 密碼 As String
密碼 = "1234"
With Sheet1 '指定的工作表
.Unprotect 密碼 '取消工作表保
.Cells.Locked = False '取消儲存格鎖定
.Cells.FormulaHidden = False '取消儲存格隱藏
For Each E In .UsedRange.Columns(1).Cells
If IsDate(E) And E < Date Then E.EntireRow.Locked = True
Next
.Protect 密碼 '工作表設定保護
End With
End Sub

複製代碼

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, UsedRange.Columns(1)) Is Nothing Then Run "Module1.Auto_Open"
End Sub

複製代碼

帖子: 173
主題: 42
精華: 0
積分: 220
點名: 0
作業系統: win10
軟體版本: Office 365
閱讀權限: 20
性別: 男
註冊時間: 2010-10-13
最後登錄: 2023-10-11

6^#

發表於 2011-12-18 19:34 | 只看該作者

回復 5# GBKEE

GBKEE版主
小於  系統日期  就鎖定整列與空白或等於系統日期  就不鎖定  可以達成
OK
但大於  系統日期無法鎖定
可以增加  如果大於  系統日期出現  錯誤警告
不給輸入  回到空白值嗎？
謝謝你  麻煩你了

HI

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 257
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-27

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2011-12-18 22:49 | 只看該作者

回復 6# mycmyc

學海無涯_不恥下問

帖子: 173
主題: 42
精華: 0
積分: 220
點名: 0
作業系統: win10
軟體版本: Office 365
閱讀權限: 20
性別: 男
註冊時間: 2010-10-13
最後登錄: 2023-10-11

8^#

發表於 2011-12-19 00:06 | 只看該作者

回復 7# Hsieh
感謝 Hsieh 版主
這方便又不用開啟巨集謝謝簡單好用

也感謝 GBKEE 讓我認識一些 VBA
以下是我在其他網頁找到  VBA 但不能用
我想找無法簡單就破解    保護工作表

程式如下可以修正使用嗎

'excel vba工程密?加密和破解
'0>注意保?版?，?供??使用。

'1>一段极好的VBA保?密?破解程序??WIN98+OFFICE97破解率100%

'2>用以下代??VBA加密保?后用offkey 6.5-7.0及Advanced VBA pASSWORD Recovery??版均?法破解出保?程式?的密?

'移除VBA??保?

Sub MoveProtect()

Dim FileName As String

FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")

If FileName = CStr(False) Then

   Exit Sub

Else

   VBAPassword FileName, False

End If

End Sub

'?置VBA??保?

Sub SetProtect()

Dim FileName As String

FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")

If FileName = CStr(False) Then

   Exit Sub

Else

   VBAPassword FileName, True

End If

End Sub

Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)

If Dir(FileName) = "" Then

   Exit Function

Else

   FileCopy FileName, FileName & ".bak"

End If

Dim GetData As String * 5

Open FileName For Binary As #1

Dim CMGs As Long

Dim DPBo As Long

For i = 1 To LOF(1)

      Get #1, i, GetData

      If GetData = "CMG=""" Then CMGs = i

      If GetData = "[Host" Then DPBo = i - 2: Exit For

Next



If CMGs = 0 Then

   MsgBox "?先?VBA???置一?保?密?...", 32, "提示"

   Exit Function

End If



If Protect = False Then

   Dim St As String * 2

   Dim s20 As String * 1



   '取得一?0D0A十六?制字串

   Get #1, CMGs - 2, St



   '取得一?20十六制字串

   Get #1, DPBo + 16, s20



   '替?加密部份机?

   For i = CMGs To DPBo Step 2

         Put #1, i, St

   Next



   '加入不配?符?

   If (DPBo - CMGs) Mod 2 <> 0 Then

      Put #1, DPBo + 1, s20

   End If

   MsgBox "文件解密成功......", 32, "提示"

Else

   Dim MMs As String * 5

   MMs = "DPB="""

   Put #1, CMGs, MMs

   MsgBox "?文件特殊加密成功......", 32, "提示"

End If

Close #1

End Function

HI