I'm trying to find a way to prevent copy/cut-pasting in excel cells. I disabled copy/pasting of cells however found a flaw that if a user copies the actual value of the cell he's able to paste thus(In only 1 cell not a range of cells) making the disabled copy/paste useless.
I used the following line of code from another question:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.CutCopyMode = False
Dim UndoList As String
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
On Error GoTo ErrExit
UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
If Left(UndoList, 5) = "Paste" Or UndoList = "Auto Fill" Then
MsgBox "Please don't paste values on this sheet." & vbCr & _
"The action will be reversed.", vbInformation, _
"Paste is not permitted"
With Application
.Undo
.CutCopyMode = False
End With
Target.Select
End If
ErrExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
How about using Application.Onkey.
Sub DisableCutCopyPaste()
Application.OnKey "^{c}", "" 'Copy
Application.OnKey "^{v}", "" 'Paste
Application.OnKey "^{x}", "" 'Cut
End Sub
Related
So I have this problem which I can't wrap my head around.
I have a an excel report that executes an important macro on sheet_activate, and as we all know macros cancel CutCopyMode.
Therefore, if I want to copy & paste something from a different file into my report, it never works because as soon as I activate my report it runs the macro and cancels the CutCopyMode from the other file.
Things I have tried:
1) save cutcopymode value and re-activate it after the macro:
Dim tmpCT
tmpCT = Application.CutCopyMode
...
Application.CutCopyMode = tmpCT
the problem: it doesnt work.
2) save the data from the clipboard and re-insert it as plain text object after the macro is done running:
Dim DataClipBoard As String
Dim clipboardData As DataObject
Dim RangeCopied As Range
Set RangeCopied = Selection
DataClipBoard = ClipBoard_GetData
Application.CutCopyMode = False
...
Set clipboardData = New DataObject
With clipboardData
.SetText DataClipBoard
.PutInClipboard
End With
Set clipboardData = Nothing
The problem: it's plain text and doesn't retain formats/links/etc.
I'd appreciate any input you can give me on this issue.
The following macro will return the current range for Cut/Copy, which you can then store in a Range variable and re-Cut/Copy after your other workbook is open.
(Personally, I think that Application.CutCopyRange should be a built-in special variable to do this.)
Function CutCopyRange() As Range
Dim StoredMode As XlCutCopyMode
StoredMode = Application.CutCopyMode
If StoredMode < 1 Then Exit Function 'Null case
If StoredMode = xlCut Then
'Disappointing, since Clipboard lets you Paste a copy of a cut range...
MsgBox "Unfortunately, Worksheet.Paste(Link:=True) only works for Copy-mode.", vbCritical
Exit Sub
End If
Dim ScreenUpdating As Boolean, DisplayAlerts As Boolean, EnableEvents As Boolean
ScreenUpdating = Application.ScreenUpdating
DisplayAlerts = Application.DisplayAlerts
EnableEvents = Application.EnableEvents
Application.ScreenUpdating = False
Application.EnableEvents = False
'This makes us loose our Cut/Copy mode...
With Worksheets.Add
.Paste Link:=True
Set CutCopyRange = Range(Range(Replace(Selection.Cells(1, 1).Formula, "=", "")), _
Range(Replace(Selection.Cells(Selection.Rows.Count, Selection.Columns.Count).Formula, "=", "")))
Application.DisplayAlerts = False
.Delete
End With
'Restore Cut/Copy mode to what it was before the previous block
Select Case StoredMode
Case xlCut
CutCopyRange.Cut
Case xlCopy
CutCopyRange.Copy
End Select
Application.DisplayAlerts = DisplayAlerts
Application.ScreenUpdating = ScreenUpdating
Application.EnableEvents = EnableEvents
End Function
Big thanks to A.S.H for helping me with out with this code earlier.
Right now, I'm attempting to show a splash sheet that tells users to enable macros in order to access the workbook. The plan is to save the file with the splash sheet visible and other sheets veryhidden during the BeforeClose event. During the Open event, the splash sheet will be made veryhidden and the other sheets will be made visible.
Hence, the user will only see the splash sheet when he/she opens the file with macros disabled. However with the below code, it doesn't seem as though the routine that makes the splash sheet visible and the rest veryhidden is running. Where have I gone wrong?
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim rs As Object, ws As Object
Dim Ans As Integer
Dim target As Range, r As Range
Set rs = Sheets("Report")
If Me.Saved = False Then
Do
Ans = MsgBox("Do you want to save the changes you made to '" & _
Me.Name & "'?", vbQuestion + vbYesNoCancel)
Select Case Ans
Case vbYes
With rs
Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
End With
target.Value = Application.Trim(target.Value)
For Each r In target.Rows
If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") > 0 Then
Cancel = True
r.Parent.Activate: r.Activate
MsgBox ("Please confirm all required fields have been completed")
Exit Sub
End If
Next
Application.ScreenUpdating = False
Sheets("Reminder").Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Reminder" Then
ws.Visible = xlSheetVeryHidden
End If
Next ws
ActiveWorkbook.Save
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Reminder" Then
ws.Visible = xlSheetVisible
End If
Next ws
Sheets("Reminder").Visible = xlSheetVeryHidden
ThisWorkbook.Saved = True
Application.ScreenUpdating = True
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
Loop Until ThisWorkbook.Saved = True
End If
End Sub
If you are experiencing screen trouble, it is likely due to some erroneous manipulation of Application.ScreenUpdating here and in other macros. In this one, the error is that you first set it to False and then Exit Sub without restoring it to True.
Moreover, since your routine only does calculation (checking) and does not change cell values, there's no point in disabling Application.ScreenUpdating.
On a side note, I think your routine that checks for empty cells can be much simplified.
Function dataIsValid() As Boolean
Dim target As Range, r As Range
With ActiveSheet ' <-- May be better change to some explicit sheet name
Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
End With
target.value = Application.Trim(target.value) ' <-- trim the whole range
For Each r In target.Rows
If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") Then
r.Parent.Activate: r.Activate ' <-- Show erroneous row
MsgBox ("Please confirm all required fields have been completed")
Exit Function
End If
Next
dataIsValid = True
End Function
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = Not dataIsValid
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = Not dataIsValid
End Sub
Need your help badly
I have code that is assigned to "button" to delete the current sheet. Sheet and workbook are password protected. I am able to use the button to delete the sheet but the problem, its not protecting the workbook back. Please suggest.
Sub Deletetab()
Application.DisplayAlerts = False
If MsgBox("Deleting Current Sheet, Data entered on this sheet will be lost", vbOKCancel) = vbOK Then
ThisWorkbook.Unprotect Password:="xyz"
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Protect Password:="xyz"
Application.DisplayAlerts = True
Else: Exit Sub
End If
Application.DisplayAlerts = True
ThisWorkbook.Protect Password:="xyz"
End Sub
Please help.
You have ThisWorkbook.Protect Password:="xyz" twice in your code.
Please try the modified code below (tested and ran ok on my Excel):
Sub Deletetab()
Application.DisplayAlerts = False
If MsgBox("Deleting Current Sheet, Data entered on this sheet will be lost", vbOKCancel) = vbOK Then
ThisWorkbook.Unprotect Password:="xyz"
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Protect Password:="xyz"
Application.DisplayAlerts = True
End If
Application.DisplayAlerts = True
End Sub
I have an Excel spreadsheet that contains 7 worksheets.
I need the script below to be applied to only some of the worksheets (Sheet6 & Sheet7) whenever the document is saved.
I've spent several hours trying different modifications, must of which simply did not work. The VBA debugger does not throw any errors, and when I test the script it never appears to run.
How can the script below be modified to run against specific worksheets, whenever I save the document from any of the worksheet tabs?
Thank you
VBA - Lock Cells & Protect Sheet On Save
The script below will lock cells that contain values, and then password protect the sheet before saving.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
Dim Cell As Range
With ActiveSheet
.Unprotect Password:=""
.Cells.Locked = False
For Each Cell In Application.ActiveSheet.UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:=""
'Protect with blank password, you can change it
End With
Exit Sub
End Sub
Script Source
Change the ActiveSheet and use a For Each loop like so:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
Dim Cell As Range
For Each sh In Array("Sheet1", "AnotherSheet", "OtherSheet")
With Sheets(sh)
.Unprotect Password:=""
.Cells.Locked = False
For Each Cell In Application.ActiveSheet.UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next
.Protect Password:=""
End With
Next
End Sub
This should help you (you'll have messages to let you know when you are in the event and when it's started and over) :
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Cell As Range
MsgBox "Event Workbook_BeforeSave Launched", vbInformation + vbOKOnly, "Started"
On Error GoTo ErrHandler
ReTry:
With Sheet6
.Unprotect Password:=""
.Cells.Locked = False
For Each Cell In .UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:=""
'Protect with blank password, you can change it
End With
With Sheet7
.Unprotect Password:=""
.Cells.Locked = False
For Each Cell In .UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:=""
'Protect with blank password, you can change it
End With
MsgBox "Event Workbook_BeforeSave Over", vbInformation + vbOKOnly, "Finished"
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Number & " :" & vbCrLf & _
Err.Description
Resume ReTry
End Sub
The code can be significantly shorted (run time wise) by
Using SpecialCells rather than looping through each cell
avoiding setting blank cells as being locked twice (minor compared to first point).
updated
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
For Each sh In Array("Sheet1", "AnotherSheet", "OtherSheet")
With Sheets(sh)
.Unprotect
.Cells.Locked = True
On Error Resume Next
.Cells.SpecialCells(xlBlanks).Locked = False
On Error GoTo 0
.Protect
End With
Next
End Sub
I am working with the bellow code:
This code do for Example: If I input any value in cell A1, cell B1 display a time stamp.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("B1:B10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "hh:mm AM/PM"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
What I am trying to do now is to protect/not editable from the user the cell "B1:B10" once time stamp has made by the macro. I google on how to protect but I am having hard time to insert those code I found. Can anyone help me how I construct/insert this code to my original code?
Private Sub Worksheet_Change(ByVal Target As Range)
'set your criteria here
If Target.Column = 1 Then
'must disable events if you change the sheet as it will
'continually trigger the change event
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "You cannot do that!"
End If
End Sub
Or this code:
'select the cell you want to be editable
Worksheets("Sheet1").Range("B2:C3").Locked = False
'then protect the entire sheet but still vba program can modify instead.
Worksheets("Sheet1").Protect UserInterfaceOnly:=True
Thanks to Kazjaw. Here is the final code.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Protect cell "B1:B10"
Worksheets("Sheet1").Cells.Locked = False
Worksheets("Sheet1").Range("B1:b10").Locked = True
Worksheets("Sheet1").Protect Password:="pass", UserInterfaceOnly:=Tru
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("B1:B10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "hh:mm AM/PM"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
If you want to protect only Range B1:B10 then you need to run this sub only once:
Sub ProtectCellsInB()
Worksheets("Sheet1").Cells.Locked = False
Worksheets("Sheet1").Range("B1:b10").Locked = True
Worksheets("Sheet1").Protect Password:="pass", UserInterfaceOnly:=True
End Sub
I made a modification- I added a password to protection which you can delete.
If you are not sure how to run it once then you could add the whole internal code at the end of your Private Sub Worksheet_Change(ByVal Target As Excel.Range)