First post is all too true, but here's the VBA
If Date > DateSerial(2003, 7, 15) Then
ActiveWorkbook.Close
End If
==========================================
You can TRY to dis-able copying of Cells with
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Rows.Count > 1 or Target.Columns.Count>1 Then Cells(Target.Row, Target.Column).Select Application.CutCopyMode = False
BUT if you hold shift down it will open the workbook in Design mode. and the workbook stays open.
===============================================
But if you stop Macros running then you are outwitted.
Or if you open Excel Spreadsheet in OpenOffice the protection is no longer there.
And for that matter forget all about Password protecting worksheets, that's yet another Microsoft joke.
=====================================
You can try forcing user to run macros with this:
Option Explicit
Const WelcomePage = "Macros"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False
'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If
'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False
'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True
'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_Open()
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
End Sub
Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False
'Record active worksheet
Set aWs = ActiveSheet
'Hide all sheets
Call HideAllSheets
'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If
'Restore file to where user was
Call ShowAllSheets
aWs.Activate
'Restore screen updates
Application.ScreenUpdating = True
End Sub
Private Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet
Worksheets(WelcomePage).Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws
Worksheets(WelcomePage).Activate
End Sub
Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws
Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub
========= and use this to KILL the Workbook after time limit with:
If Date < #10/31/2003# Then Exit Sub
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
===== and stop the users changing clock by getting Date from US navy, thus
The Navy being the Navy, their download format sometimes changes, but I (original author) just modified the formatting section of this macro today so it works fine. This macro adjusts for United States Pacific time, so you'd need to modify the 8 in this line
Range("B1").Formula = "=R1C1-TIME(8,,)"
to the hour you are set for wherever you are. I live in San Francisco, so my macro has an 8 for my local time, because California is 8 hours behind Greenwich. Note, I added a space in between HTML characters so delete those spaces if you copy this macro.
Sub TimeAfterTime()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Dim WebCopy As Object
Dim WebURL As String
Set WebCopy = Sheets("Sheet2")
WebURL = "http://tycho.usno.navy.mil/cgi-bin/timer.pl"
WebCopy.Activate
Cells.Clear
With WebCopy.QueryTables.Add(Connection:="URL;" & WebURL, Destination:=WebCopy.Range("A1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Range("1:2").EntireRow.Delete
Range(("A2"), Range("A2").End(xlDown)).EntireRow.Delete
With Range("A1")
.Replace What:=" < BR > ", Replacement:=""
.Replace What:="UTC", Replacement:=""
.Replace What:=".", Replacement:=""
.Replace What:=", ", Replacement:=", " & Year(Now) & " "
.Value = Trim(.Value)
.NumberFormat = "mmmm d, yyyy, hh:mm:ss"
End With
Range("B1").Formula = "=R1C1-TIME(8,,)"
Range("B1").Value = Range("B1").Value
Columns(2).AutoFit
Columns(1).Delete Shift:=xlToLeft
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub
===================================
You could try writing a Visual Basic app using the Spreadsheet control and disabling the clipboard, that might work if you then time limited the VB app. But I am only guessing...
All found on the web and untested, the short answer to your question is NO!!