Home |
Search |
Today's Posts |
#5
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]() Hi Gord OK Thanks for your help. I've inserted the module into my wb with this as the code : Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 1 Sub TimeBombMakeReadOnly() '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''' ' TimeBombMakeReadOnly ' This procedure uses a defined name to store the expiration ' date and if the workbook has expired, makes the workbook ' read-only. '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''' Dim ExpirationDate As String Dim NameExists As Boolean On Error Resume Next ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2) If Err.Number < 0 Then ''''''''''''''''''''''''''''''''''''''''''' ' Name doesn't exist. Create it. ''''''''''''''''''''''''''''''''''''''''''' ExpirationDate = CStr(DateSerial(Year(Now), _ Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION)) ThisWorkbook.Names.Add Name:="ExpirationDate", _ RefersTo:=Format(ExpirationDate, "short date"), _ Visible:=False NameExists = False Else NameExists = True End If '''''''''''''''''''''''''''''''''''''''''''''''''' '''' ' If the today is past the expiration date, make the ' workbook read only. We need to Save the workbook ' to keep the newly created name intact. '''''''''''''''''''''''''''''''''''''''''''''''''' '''' If CDate(Now) = CDate(ExpirationDate) Then If NameExists = False Then ThisWorkbook.Save End If ThisWorkbook.ChangeFileAccess xlReadOnly End If End Sub i hope this is how it's meant to be. I haven't changed anything , although I made it one day so that I can see if it works by tomorrow. I have a small question : I really need this routine to start counting down as soon as the wb is opened for the first time , on any machine. Does the macro have to be run to set it working on each machine? If so , it sort of defeats the object...! Also , could you suggest some code to bring up a message box to show the wb has expired? Thanks Colin In article , Gord Dibben <gorddibbATshawDOTca@?.? writes See in-line responses.............. On Fri, 30 Nov 2007 13:35:38 +0000, Colin Hayes wrote: Hi OK Thanks. I thought I'd try the one below. I have a couple of questions though , if you could advise ; The workbook it's protecting is called 'Receipts' - do I need to put this anywhere in the code? No. Thisworkbook is the workbook you are running the Sub on. If I use this on more than one wb , do I need to change the name of the file it stores , so as not to overwrite it. No changes necessary as far as I can tell.....Thisworkbook refers to whatever workbook the code is in. I assume the file it is storing is 'Expiration date'. It's not clear to me where it stores the file.... Expiration Date is a named range which holds the date to expire. The code creates this named range. The line...........Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 90 must be placed above the line..........Sub TimeBombMakeReadOnly() Also , I'm not sure where I should be placing the code in the workbook. Under the tab at the bottom , or under the Excel symbol at top-left of the sheet...? Alt + F11 to open VB Editor CTRL + r to open Project Explorer if not visible. Right-click on your workbook and InsertModule. Paste code into that module with the edits above. Save the workbook then run the macro which sets the time to expire as 90 days from when you run the macro. Have you downloaded the sample workbook from Chip's site to see how he has done it? Gord Sub TimeBombMakeReadOnly() '''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''' ' TimeBombMakeReadOnly ' This procedure uses a defined name to store the expiration ' date and if the workbook has expired, makes the workbook ' read-only. '''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''' Dim ExpirationDate As String Dim NameExists As Boolean On Error Resume Next ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2) If Err.Number < 0 Then ''''''''''''''''''''''''''''''''''''''''''' ' Name doesn't exist. Create it. ''''''''''''''''''''''''''''''''''''''''''' ExpirationDate = CStr(DateSerial(Year(Now), _ Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION)) ThisWorkbook.Names.Add Name:="ExpirationDate", _ RefersTo:=Format(ExpirationDate, "short date"), _ Visible:=False NameExists = False Else NameExists = True End If '''''''''''''''''''''''''''''''''''''''''''''''' '''''' ' If the today is past the expiration date, make the ' workbook read only. We need to Save the workbook ' to keep the newly created name intact. '''''''''''''''''''''''''''''''''''''''''''''''' '''''' If CDate(Now) = CDate(ExpirationDate) Then If NameExists = False Then ThisWorkbook.Save End If ThisWorkbook.ChangeFileAccess xlReadOnly End If End Sub Thanks again. In article , Gord Dibben <gorddibbATshawDOTca@?.? writes Colin See Chip Pearson's site for creating a Time Bombed workbook. http://www.cpearson.com/excel/workbooktimebomb.aspx Gord Dibben MS Excel MVP On Fri, 30 Nov 2007 01:52:58 +0000, Colin Hayes wrote: Hi I need to have an excel file 'expire' 3 months after first installation. Is it possible to build something into the program so that it will read the date on first use and stop functioning after a set time , perhaps with a popup too? Any help appreciated. Thanks |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Installation Error: File not Found | Excel Discussion (Misc queries) | |||
Installation Problem - Missing File | Excel Discussion (Misc queries) | |||
Installation error, file not found | Excel Discussion (Misc queries) | |||
excel won't open, keeps saying installation file missing? | Excel Discussion (Misc queries) | |||
A required installation file E2561412.CAB could not be found | Excel Discussion (Misc queries) |