麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] EXCEL設定某日期到檔案無法開啟 [打印本頁]

作者: hueywen_jia 時間: 2015-2-25 02:05 標題: 請教EXCEL VBA 某日期到限制某巨集的使用

請教高手,我在EXCEL設了一個巨集,但我希望在一個月後這個巨集就無法使用,要怎麼做? 謝謝

作者: hueywen_jia 時間: 2015-2-25 02:15 標題: EXCEL設定某日期到檔案無法開啟

各位高手,請問EXCEL是否可以設定當某個日期到時,某個檔案則無法開啟呢? 謝謝

作者: rouber590324 時間: 2015-2-25 08:12

如下煩copy新excel 試試 (原excel保留備用)

Private Sub Workbook_Open()
Application.DisplayAlerts = False
If Date > "02/23/2015" Then
ThisWorkbook.Close False
End If
End Sub

作者: rouber590324 時間: 2015-2-25 08:18

如下試試

Private Sub Workbook_Open()
Application.DisplayAlerts = False
If Date < "02/23/2015" Then

巨集

End If
End Sub

作者: hueywen_jia 時間: 2015-3-2 22:06

回復 4# rouber590324

感謝rouber590324回復,測試後可!! 謝謝~~

作者: hueywen_jia 時間: 2015-3-2 22:25

回復 5# hueywen_jia

更正~~更正~~~不能刪文也無法修改了,sorry~

經過測試是不能使用的,會出現有END IF ,卻沒有IF

[attach]20356[/attach]

作者: rouber590324 時間: 2015-3-3 10:47

煩將 SUB MACROL() 刪除啦

作者: hueywen_jia 時間: 2015-3-12 00:07

回復 6# hueywen_jia

GBAEE sorry因為我看不懂,因為不會語法

作者: hueywen_jia 時間: 2015-3-12 00:10

煩將 SUB MACROL() 刪除啦
rouber590324 發表於 2015-3-3 10:47

rouber590324：

Private Sub Workbook_Open()
Application.DisplayAlerts = False
If Date < "02/23/2015" Then

'
' Macro1 Macro
' user 在 2015/2/24 錄製的巨集
'
' 快速鍵: Ctrl+Shift+J
'
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
ActiveCell.FormulaR1C1 = "2"
Range("A3").Select
ActiveCell.FormulaR1C1 = "3"
Range("B1").Select
ActiveCell.FormulaR1C1 = "4"
Range("B2").Select
ActiveCell.FormulaR1C1 = "5"
Range("B3").Select
ActiveCell.FormulaR1C1 = "6"
Range("B4").Select

End If
End Sub

刪了SUB MACROL() 變成找不到巨集了

作者: GBKEE 時間: 2015-3-12 06:01

本帖最後由 GBKEE 於 2015-3-12 06:02 編輯

回復 4# rouber590324
Date > "02/23/2015" 是錯誤的語法

Option Explicit
Sub Ex()
MsgBox "Date = " & Date
MsgBox Date > "04/23/2015"
MsgBox Date > #4/23/2015#
MsgBox Date > DateValue("04/23/2015")
MsgBox Date < "04/23/2015"
MsgBox Date < #4/23/2015#
MsgBox Date < DateValue("04/23/2015")
End Sub

複製代碼

回復 9# hueywen_jia

附檔看看

作者: hueywen_jia 時間: 2015-3-12 21:49

回復 rouber590324
Date > "02/23/2015" 是錯誤的語法回復 hueywen_jia

附檔看看
GBKEE 發表於 2015-3-12 06:01

更正一下,我有改成04/23/2015,但就找不到,我附檔請求高手幫我,謝謝

[attach]20427[/attach]

作者: hueywen_jia 時間: 2015-3-16 00:00

回復 11# hueywen_jia

無法上傳檔案,是因為我的等級太低嗎? 壓縮後無法上傳,這次可了~請見附檔為我解答,謝謝

Private Sub Workbook_Open()
Application.DisplayAlerts = False
If Date < "04/23/2015" Then

'
' Macro1 Macro
' user 在 2015/3/25 錄製的巨集
'
' 快速鍵: Ctrl+Shift+J
'
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
ActiveCell.FormulaR1C1 = "2"
Range("A3").Select
ActiveCell.FormulaR1C1 = "3"
Range("B1").Select
ActiveCell.FormulaR1C1 = "4"
Range("B2").Select
ActiveCell.FormulaR1C1 = "5"
Range("B3").Select
ActiveCell.FormulaR1C1 = "6"
Range("B4").Select

End If
End Sub

[attach]20439[/attach]

作者: GBKEE 時間: 2015-3-16 05:56

回復 12# hueywen_jia
Private Sub Workbook_Open()
程序將 Private (私用)刪掉
如圖重新指定巨集
[attach]20441[/attach]

第10帖有提到 Date > "02/23/2015" 是錯誤的語法

Private Sub Workbook_Open()
Stop '按F8逐行執行程式碼
If Date > "01/01/2016" Then
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
ActiveCell.FormulaR1C1 = "2"
Range("A3").Select
ActiveCell.FormulaR1C1 = "3"
Range("B1").Select
ActiveCell.FormulaR1C1 = "4"
Range("B2").Select
ActiveCell.FormulaR1C1 = "5"
Range("B3").Select
ActiveCell.FormulaR1C1 = "6"
Range("B4").Select
End If
End Sub

複製代碼

Private Sub Workbook_Open() 是ThisWorkbook模組的預設事件程序
於Excel檔案開啟時自動執行的程序
如圖
[attach]20442[/attach]

作者: hueywen_jia 時間: 2015-3-28 23:13

大大您好,

可是我點了左方的This Workbook,再點右方的時候只有出現"一般",沒有Open可以選呀.........還是可以幫我用檔案做修改後再上傳給我呢? 我要使用在檔案中(現用活頁簿),而非個人巨集活頁簿,謝謝

[attach]20538[/attach]
[attach]20536[/attach]

作者: GBKEE 時間: 2015-3-29 06:35

回復 14# hueywen_jia
沒用心學習,它有兩個選項,你的附檔失敗.

[attach]20539[/attach]

作者: hueywen_jia 時間: 2015-4-1 01:29

大大~~冤枉啊~~~不是我沒有用心學習,是我的那個下拉只有一個 "一般" 沒有下面那個!!
另外我想說附檔就用之前附上的那個做修改後再上傳給我就好了~所以才沒再上傳附檔~~SORRY~

作者: hueywen_jia 時間: 2015-4-1 01:38

真是討厭....超過三分鐘就不給修改........
補說明一下

當我點選左上方的This Workbook(圖紅色框),再點右上方的選單時,只出現"一般",並沒有"Workbook",而且點右方選單時,我發現我的左方那個選單就跳到Sheet1(圖綠色框),不是我沒有選喔!! 我要特別說明一下

[attach]20554[/attach]

作者: stillfish00 時間: 2015-4-1 10:08

本帖最後由 stillfish00 於 2015-4-1 10:14 編輯

回復 17# hueywen_jia
左邊的ThisWorkBook要先點兩下
下拉選單那邊就會有了

只點一下是不會進到所選的程式碼頁面

作者: hueywen_jia 時間: 2015-4-6 18:10

本帖最後由 Hsieh 於 2015-5-17 23:00 編輯

原來是點兩下,雖然出現了,可是我複製了之前大大給的字串貼進去後還是無法執行,跳到F8那欄是錯誤的語法,SORRY~我笨拙~不會用這種
請高手幫我,我想讓附檔中的所有巨集在某個時間一到就無法使用,最好是檔案都無法開啟是最好的!! 可以告訴我怎麼做嗎? 或是幫我修改檔案後再回傳給我呢? 因為檔案有點大,需要用到很多活頁簿及公式,謝謝
[attach]20590[/attach]

作者: GBKEE 時間: 2015-4-7 15:43

本帖最後由 GBKEE 於 2015-4-7 15:45 編輯

回復 19# hueywen_jia

附檔中的所有巨集在某個時間一到就無法使用,最好是檔案都無法開啟是最好的

ThisWorkbook模組的程式碼

Private Sub Workbook_Open() '活頁簿的預設事件程序(開啟檔案時自動執行)
Dim MyDate As Date
MyDate = #6/1/2015# '你要如何指定日期
If Date >= MyDate Then Application.Quit
'Application.Quit 關閉Excel
End Sub

複製代碼

作者: hueywen_jia 時間: 2015-4-9 20:46

謝謝樓上大大,可是我用了之後,開啟檔案出現：[attach]20614[/attach]
我點 "是"跟"否"檔案可以關閉沒錯,但是我點"取消",就不會自動關閉,而且還可以使用巨集!! 怎麼辦!?

Private Sub Workbook_Open()
Dim MyDate As Date
MyDate = #4/4/2015#
If Date >= MyDate Then Application.Quit
End Sub

作者: GBKEE 時間: 2015-4-10 14:57

回復 21# hueywen_jia

ThisWorkbook模組的程式碼

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean) '活頁簿的預設事件程序(關閉檔案時自動執行)
Me.Save
End Sub

複製代碼

活頁簿模組的預設事件還有許多,可練習看看
工作表模組一樣有許多的預設事件

[attach]20624[/attach]

作者: luhpro 時間: 2015-4-11 07:31

謝謝樓上大大,可是我用了之後,開啟檔案出現：
我點 "是"跟"否"檔案可以關閉沒錯,但是我點"取消",就不會自動 ...
hueywen_jia 發表於 2015-4-9 20:46

底下這個方式即使檔案設成唯讀, 也照樣能關閉檔案:

Private Sub Workbook_Open()
Dim MyDate As Date
MyDate = #4/4/2015#
If Date >= MyDate Then
With Application
.DisplayAlerts = False
.Quit
End With
End If
End Sub

複製代碼

作者: KdStudio 時間: 2015-4-11 13:36

要指定某日後巨集無法使用，也可以改變驗證方式。
指定日期，如上面前輩所寫的，
IF DATE > "日期" THEN
關閉活頁簿
END IF

改變驗證方式，可以配合GOOGLE 試算表。(可設定不顯示網頁)
活頁簿打開，自動打開網頁，進入GOOGLE 試算表，去抓指定欄位的值，如果值跟你事先輸入VBA的值相同，就繼續。如果值不相同，就強制關閉活頁簿。

這方式比較具有彈性。

作者: hueywen_jia 時間: 2015-4-12 22:42

感謝luhpro,雖然你的設定是可成功,但是像我這麼小聰明的還是有法破解,我相信應該還是有人可以破解,只要把電腦時間改在我設定的日期前,還是可以開啟~~這點好像很難讓它不成功厚.......
所以我也很頭痛!!

作者: luhpro 時間: 2015-4-13 00:07

本帖最後由 luhpro 於 2015-4-13 00:18 編輯

感謝luhpro,雖然你的設定是可成功,但是像我這麼小聰明的還是有法破解,我相信應該還是有人可以破解,只要把電 ...
hueywen_jia 發表於 2015-4-12 22:42

其實不論是怎樣的保護都有可能被破解.

最簡單的方法是取得檔案後,
先製作其備份,
接著就是矛與盾的問題囉.

我也曾想過日期到了時直接刪除自身檔案,
不過只要依上述先執行過,
遇到不能用時先改日期後再Copy回去照樣能繼續使用,
除非檔案內資料與目前日期有正相關,
日期不對結果就不具參考價值,
當然那又是另一種破解方式了.

或者寫參考值到登錄檔執行時立即作比對,
寫參考值到另一個加密檔案裡...等等,
當然...還是本篇開頭那句話...

後續再補充:
或者若確認電腦開啟檔案時一定會上網,
那麼日期直接跟國家時間與頻率標準實驗室抓,
這樣改電腦本身日期的破解方式就沒有用了.

作者: hueywen_jia 時間: 2015-4-15 23:42

那麼請問luhpro大大~~
您可會寫日期一到就直接刪除該檔呢? 這個不錯!! 因為不會有人想到,就算改回日期,檔案還是沒得救了!! 謝謝

作者: luhpro 時間: 2015-4-16 22:06

那麼請問luhpro大大~~
您可會寫日期一到就直接刪除該檔呢? 這個不錯!! 因為不會有人想到,就算改回日期,檔案 ...
hueywen_jia 發表於 2015-4-15 23:42

網路上找到的:
刪除巨集所在的活頁簿

作者: hueywen_jia 時間: 2015-4-16 22:36

回復 28# luhpro

下列巨集會先將檔案本身改以唯讀的方式開啟，再刪除原來的檔案，然後關閉唯讀檔。

可用於限制檔案的使用期限，期限一到就刪除檔案。

可是我要在哪設定日期呢? 看不懂,因為我不懂巨集中的公式

Sub 刪除自己()
ThisWorkbook.Saved = True
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
Kill ThisWorkbook.FullName
ThisWorkbook.Close SaveChanges:=False
End Sub

作者: hueywen_jia 時間: 2015-4-28 00:04

本帖最後由 hueywen_jia 於 2015-4-28 00:06 編輯

沒有人回應我......有沒有可以幫幫我呀~~謝謝

作者: luhpro 時間: 2015-4-29 21:39

本帖最後由 luhpro 於 2015-4-29 21:52 編輯

回復 30# hueywen_jia
晤...這陣子比較忙...

以下程式碼放在 ThisWorkBook 內:

Public Sub 刪除自己()
ThisWorkbook.Saved = True
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
Kill ThisWorkbook.FullName
ThisWorkbook.Close SaveChanges:=False
End Sub
Private Sub Workbook_Open()
If Date > #5/28/2115# Then 刪除自己 ' 今天為此日期時, 刪除本檔案, 注意 : 檔案刪除後無法復原, 測試時請務必先備份本檔案.
End Sub

複製代碼

作者: taiwan16699 時間: 2015-5-5 16:59

If Date > DateValue("2015/05/01") Then
MsgBox ("已超使用期間，不可使用。請求助開發者!!")
Exit Sub
End If

Q1 = Application.InputBox(prompt:="請輸入製作者名稱：")
If Q1 = "Vercent" Then
Else: MsgBox "密碼錯誤，即將退出！"
ActiveWorkbook.Close savechanges = False
End If

作者: hueywen_jia 時間: 2015-5-7 00:25

本帖最後由 hueywen_jia 於 2015-5-7 00:27 編輯

感謝luhpro大大,可是我照您給的1-10項的字串放進去不能用! 一樣是放ThisWorkBook裡的OPEN嗎?

作者: hueywen_jia 時間: 2015-5-7 00:28

If Date > DateValue("2015/05/01") Then
MsgBox ("已超使用期間，不可使用。請求助開發者!!")
...
taiwan16699 發表於 2015-5-5 16:59

大大~我不知道該放哪耶~可以詳細的說明嗎? SORRY~我不會BASIC語法

作者: luhpro 時間: 2015-5-7 05:30

本帖最後由 luhpro 於 2015-5-7 05:36 編輯

感謝luhpro大大,可是我照您給的1-10項的字串放進去不能用! 一樣是放ThisWorkBook裡的OPEN嗎?
hueywen_jia 發表於 2015-5-7 00:25

[attach]20884[/attach]
其實裡面有刪除自己跟 ThisWorkBook 的 Open(開啟程式時就會執行,而它在設定的時間到時會呼叫刪除自己這個程序) 兩個程序.
底下這一段就是 ThisWorkBook裡的OPEN 程序喔.

Private Sub Workbook_Open()
If Date > #5/28/2115# Then 刪除自己 ' 今天為此日期時, 刪除本檔案, 注意 : 檔案刪除後無法復原, 測試時請務必先備份本檔案.
End Sub

複製代碼

作者: hueywen_jia 時間: 2015-5-10 20:59

回復 35# luhpro

我照您的方式,但卻出現此對話框
[attach]20901[/attach]

作者: GBKEE 時間: 2015-5-11 06:01

回復 36# hueywen_jia
這樣的發問太隨便了

告訴你編譯錯誤且有說明為何不看說明.VBA的說明真的有那麼難理解嗎?

作者: luhpro 時間: 2015-5-11 23:30

本帖最後由 luhpro 於 2015-5-11 23:38 編輯

回復 luhpro
我照您的方式,但卻出現此對話框
hueywen_jia 發表於 2015-5-10 20:59

你的 Then 後面沒指令.

If...Then... 指令的其中兩種語法:
1.
If 條件式 Then 要執行的指令

(此法為當條件成立時,
程式會執行 Then 後面的指令,
否則不執行該指令,
且不論結果如何執行完畢後會繼續執行下一行的指令,
意即 If 的判斷與執行是在該行跑完後就已經結束)

2.
If 條件式 Then
要執行的指令
End If

(此法為當條件成立時,
程式會執行 Then 的下一行直到 End If 前的每一行指令,
意即 If 的判斷與執行是在該行開始起,
一直到 End If 指令才結束)

需留意兩種語法的差別,
Then 後面沒指令時就一定要有 End If
反之亦同.

是的,當你條件成立後只需要執行一行指令時,用第 1 種語法就可以了,
若為多行則應用第 2 種語法.

另外,你在套用的時候,
應該要先都全部 Copy 過去,
再依據你的需求做調整.

例如你本來就有 Private Sub Workbook_Open() 時,
Copy 過去會變成有兩個 Open 程序,
這時就要試著把它們整合在同一個 Open 程序內,
看是要前後放,
還是將其中一個程序插在另一個程序的內部.
再刪掉多的那兩行 Sub Workbook_Open 與 End Sub.

除非你確實已經了解了那些指令式在做甚麼,
不然不建議隨意刪減.

完整的該行是:
If Date > #5/28/2115# Then 刪除自己
刪除自己在 ' 前不是在其後,
所以它是一個指令.
且你也要把 Sub 刪除自己到 End Sub 部分 Copy 過去,
不然一樣會發生找不到刪除自己程序的錯誤.

作者: hueywen_jia 時間: 2015-5-12 21:13

回復 38# luhpro

[attach]20934[/attach]

我照那些字串COPY進去了,可是它還是出現"編譯錯誤:沒有定義這個Sub或Sunciton 然後在刪除自己那反黑了,是找不到這個"刪除自己" 嗎

作者: luhpro 時間: 2015-5-12 22:00

回復 luhpro
我照那些字串COPY進去了,可是它還是出現"編譯錯誤:沒有定義這個Sub或Sunciton 然 ...
hueywen_jia 發表於 2015-5-12 21:13

是啊,
38# 最末尾有說了:
且你也要把 Sub 刪除自己到 End Sub 部分 Copy 過去,
不然一樣會發生找不到刪除自己程序的錯誤.

作者: hueywen_jia 時間: 2015-5-14 21:07

回復 40# luhpro

我把以下字串都放進去了,這樣不對嗎？請看我的圖片,都有進去呀~

Private Sub Workbook_Open()

If Date > #5/11/2015# Then 刪除自己

End Sub

作者: luhpro 時間: 2015-5-15 01:24

本帖最後由 luhpro 於 2015-5-15 01:31 編輯

回復 luhpro
我把以下字串都放進去了,這樣不對嗎？請看我的圖片,都有進去呀~
Private Sub Work ...
hueywen_jia 發表於 2015-5-14 21:07

底下桃紅色這一塊 (刪除自己)程序實體也要放進去,
Workbook_Open 中 Then 後面的刪除自己指令才呼叫的到該程序喔:

Public Sub 刪除自己()

ThisWorkbook.Saved = True

ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly

Kill ThisWorkbook.FullName

ThisWorkbook.Close SaveChanges:=False

End Sub

Private Sub Workbook_Open()

If Date > #5/28/2115# Then 刪除自己 ' 今天為此日期時, 刪除本檔案, 注意 : 檔案刪除後無法復原, 測試時請務必先備份本檔案.
End Sub

作者: hueywen_jia 時間: 2015-5-16 00:34

回復 42# luhpro

終於成功了!!　感謝 luhpro　的大力協助！　不願其煩的幫我解答～因為巨集的文法真的不會，不曾學過，都只有用錄製的方式來寫巨集，真是感激不盡！！　再次謝謝你！～

作者: luhpro 時間: 2015-5-17 21:24

回復 hueywen_jia
另外可否請有權限的大大幫我刪除我附件的壓縮檔呢(在第二頁下方WENWENWENWENW ...
hueywen_jia 發表於 2015-5-16 00:39

下次上傳的範例檔案,
可以酌情將討論串中用不到的部分工作表刪除,
討論會用到的資料可以酌情取用代表性的文字,
若是人名等可能觸犯到個資法的資料則酌予Mark(例如 : 王xx、李一一...等)或是用張三、李四、王美女等替代,
善用編輯->取代功能就可以很方便達成此目的,
不過要留意適當安排好先後順序,
例如若先用 5 取代 3,
之後就不適宜用 7 取代 5.(可能會破壞資料的唯一性)

總之要提供怎麼樣內容的範例檔案要看討論的目的與需求.

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)