返回列表 上一主題 發帖

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

mycmyc

帖子
173 
主題
42 
精華
0 
積分
220 
點名
0  
作業系統
win10 
軟體版本
Office 365 
閱讀權限
20 
性別
男 
註冊時間
2010-10-13 
最後登錄
2023-10-11 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-12-18 01:22 | 只看該作者

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

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

這參考 GBKEE  大大 給我的指導  
但  無法實現
目的  只有今日 日期 可以修改 可以輸入   今日之前 鎖定 無法修改後  
目前無法判別  A:A 日期   只要有輸入  就鎖定  沒輸入就可以輸入
請幫我修改一下   謝謝
Book1.rar (17.61 KB)
收藏 分享
HI

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2011-12-18 16:11 | 只看該作者
回復 1# mycmyc
有問題附檔上來會清楚些!

Module1 的程式碼
  1. Public 密碼, Rng As Range
  2. 'Public ->變數公用於此專案
  3. Private Sub Auto_Open()       '一般 Module中 開啟檔案時會自動執行的程序
  4.     密碼 = "1234"
  5.     With Sheet(1)                                   '指定的工作表
  6.         .Activate
  7.         .Unprotect 密碼                             '取消工作表保
  8.         .Cells.Locked = True                        '儲存格鎖定
  9.         .Cells.FormulaHidden = True                 '儲存格隱藏
  10.         Set Rng = .Cells(.UsedRange.Rows.Count + 1, 1)
  11.         'Rng  設定已使用範圍第1欄最後的下一個空白儲存格
  12.         Rng.Locked = False
  13.         Rng.FormulaHidden = False
  14.         .Protect 密碼                               '工作表設定保護
  15.     End With
  16.     Rng.Select
  17. End Sub
複製代碼
Sheet(1)的程式碼
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Rng.Value <> Date Then
  3.         Unprotect 密碼                             '取消工作表保
  4.         Cells.Locked = True                        '儲存格鎖定
  5.         Cells.FormulaHidden = True                 '儲存格隱藏
  6.         Rng.Locked = False
  7.         Rng.FormulaHidden = False
  8.         Protect 密碼                               '工作表設定保護
  9.     ElseIf Rng.Value = Date Then
  10.         Unprotect 密碼                             '取消工作表保
  11.     End If
  12. End Sub
複製代碼

TOP

mycmyc

帖子
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  值是空白  就可以修改或新增
麻煩你
  1. Public 密碼, Rng As Range
  2. 'Public ->變數公用於此專案
  3. Private Sub Auto_Open()       '一般 Module中 開啟檔案時會自動執行的程序
  4.     密碼 = "1234"
  5.     With Sheet1  [color=Red]此行我修改 Sheet1 非大大你  Sheet（1）[/color]                              '指定的工作表
  6.         .Activate
  7.         .Unprotect 密碼                             '取消工作表保
  8.         .Cells.Locked = True                        '儲存格鎖定
  9.         .Cells.FormulaHidden = True                 '儲存格隱藏
  10.         Set Rng = .Cells(.UsedRange.Rows.Count + 1, 1)
  11.         'Rng  設定已使用範圍第1欄最後的下一個空白儲存格
  12.         Rng.Locked = False
  13.         Rng.FormulaHidden = False
  14.         .Protect 密碼                               '工作表設定保護
  15.     End With
  16.     Rng.Select
  17. End Sub
複製代碼
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Rng.Value <> Date Then
  3.         Unprotect 密碼                             '取消工作表保
  4.         Cells.Locked = True                        '儲存格鎖定
  5.         Cells.FormulaHidden = True                 '儲存格隱藏
  6.         Rng.Locked = False
  7.         Rng.FormulaHidden = False
  8.         Protect 密碼                               '工作表設定保護
  9.     ElseIf Rng.Value = Date Then
  10.         Unprotect 密碼                             '取消工作表保
  11.     End If
  12. End Sub
複製代碼
Book1.rar (17.35 KB)
HI

TOP

mycmyc

帖子
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

TOP

GBKEE

帖子
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
  1. Private Sub Auto_Open()       '一般 Module中 開啟檔案時會自動執行的程序
  2.     Dim E As Range, 密碼 As String
  3.     密碼 = "1234"
  4.     With Sheet1                                 '指定的工作表
  5.         .Unprotect 密碼                             '取消工作表保
  6.         .Cells.Locked = False                        '取消儲存格鎖定
  7.         .Cells.FormulaHidden = False                 '取消儲存格隱藏
  8.         For Each E In .UsedRange.Columns(1).Cells
  9.             If IsDate(E) And E < Date Then E.EntireRow.Locked = True
  10.         Next
  11.         .Protect 密碼                               '工作表設定保護
  12.     End With
  13. End Sub
複製代碼
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Not Application.Intersect(Target, UsedRange.Columns(1)) Is Nothing Then Run "Module1.Auto_Open"
  3. End Sub
複製代碼

TOP

mycmyc

帖子
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

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 2011-12-18 22:49 | 只看該作者
回復 6# mycmyc

play.gif
學海無涯_不恥下問

TOP

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

TOP

        靜思自在 : 閒人無樂趣，忙人無是非。
返回列表 上一主題