Preventing Copy, Paste of cells, printing of sheet/workbook

nagaita

New Member
Joined
May 29, 2014
Messages
1
Hey folks,

Was hoping to get some guidance on VBA codes for Excel 2010 for:

1. Disabling Copy and Paste of cells
  • I have protected the sheets and prevented selection of cells but this makes it hard for other viewers to "Ctrl + F" my sheet.
  • I've also copied the code to prevent right clicks but, this does not stop "Ctrl C" and "Ctrl V".
  • imo, The greatest complication is because the disabling copy and paste code has to fit in with this code (that forces users to enable macros)
Code:
'Force the explicit declaration of variables

Option Explicit



'Assign the name of the warning sheet to a constant
Const Warning As String = "Warning"
 
Private Sub Workbook_Open()


    'Turn off screen updating
    Application.ScreenUpdating = False
    
    'Call the ShowAllSheets routine
    Call ShowAllSheets
    
    'Set the workbook's Saved property to True
    Me.Saved = True
    
    'Turn on screen updating
    Application.ScreenUpdating = True
    
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)


    'Declare the variable
    Dim Ans As Integer
    
    'If the workbook's Saved property is False, emulate Excel's default save prompt
    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
                    Call CustomSave
                Case vbNo
                    Me.Saved = True
                Case vbCancel
                    Cancel = True
                    Exit Sub
            End Select
        Loop Until Me.Saved
    End If
    
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


    'Cancel regular saving
    Cancel = True
    
    'Call the CustomSave routine
    Call CustomSave(SaveAsUI)
    
End Sub


Private Sub CustomSave(Optional SaveAs As Boolean)


    'Declare the variables
    Dim ActiveSht As Object
    Dim FileFormat As Variant
    Dim FileName As String
    Dim FileFilter As String
    Dim FilterIndex As Integer
    Dim Msg As String
    Dim Ans As Integer
    Dim OrigSaved As Boolean
    Dim WorkbookSaved As Boolean
    
    'Turn off screen updating
    Application.ScreenUpdating = False
    
    'Turn off events so that the BeforeSave event doesn't occur
    Application.EnableEvents = False
    
    'Assign the status of the workbook's Saved property to a variable
    OrigSaved = Me.Saved
    
    'Assign the active sheet to an object variable
    Set ActiveSht = ActiveSheet
    
    'Call the HideAllSheets routine
    Call HideAllSheets
    
    'Save workbook or prompt for SaveAs filename
    If SaveAs Or Len(Me.Path) = 0 Then
        If Val(Application.Version) < 12 Then
            FileFilter = "Microsoft Office Excel Workbook (*.xls), *.xls"
            FilterIndex = 1
        Else
            FileFilter = "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm, " & _
                "Excel 97-2003 Workbook (*.xls), *.xls"
            If Right(Me.Name, 4) = ".xls" Then
                FilterIndex = 2
            Else
                FilterIndex = 1
            End If
        End If
        Do
            FileName = Application.GetSaveAsFilename( _
                InitialFileName:=Me.Name, _
                FileFilter:=FileFilter, _
                FilterIndex:=FilterIndex, _
                Title:="SaveAs")
            If FileName = "False" Then Exit Do
            If IsLegalFilename(FileName) = False Then
                Msg = "The file name is invalid.  Try one of the "
                Msg = Msg & "following:" & vbCrLf & vbCrLf
                Msg = Msg & Chr(149) & " Make sure that the file name "
                Msg = Msg & "does not contain any" & vbCrLf
                Msg = Msg & "   of the following characters:  "
                Msg = Msg & "< > ? [ ] : | or *" & vbCrLf
                Msg = Msg & Chr(149) & " Make sure that the file/path "
                Msg = Msg & "name does not exceed" & vbCrLf
                Msg = Msg & "   more than 218 characters."
                MsgBox Msg, vbExclamation, "Invalid File Name"
            Else
                If Val(Application.Version) < 12 Then
                    FileFormat = -4143
                Else
                    If Right(FileName, 4) = ".xls" Then
                        FileFormat = 56
                    Else
                        FileFormat = 52
                    End If
                End If
                If Len(Dir(FileName)) = 0 Then
                    Application.DisplayAlerts = False
                    Me.SaveAs FileName, FileFormat
                    Application.DisplayAlerts = True
                    WorkbookSaved = True
                Else
                    Ans = MsgBox("'" & FileName & "' already exists.  " & _
                        "Do you want to replace it?", vbQuestion + vbYesNo, _
                        "Confirm Save As")
                    If Ans = vbYes Then
                        Application.DisplayAlerts = False
                        Me.SaveAs FileName, FileFormat
                        Application.DisplayAlerts = True
                        WorkbookSaved = True
                    End If
                End If
            End If
        Loop Until Me.Saved
    Else
        Application.DisplayAlerts = False
        Me.Save
        Application.DisplayAlerts = True
        WorkbookSaved = True
    End If
    
    'Call the ShowAllSheets routine
    Call ShowAllSheets
    
    'Activate the prior active sheet
    ActiveSht.Activate
    
    'Set the workbook's Saved property
    If WorkbookSaved Then
        Me.Saved = True
    Else
        Me.Saved = OrigSaved
    End If
    
    'Turn on screen updating
    Application.ScreenUpdating = True
    
    'Turn on events
    Application.EnableEvents = True
    
End Sub


Private Sub HideAllSheets()


    'Declare the variable
    Dim Sh As Object
    
    'Display the warning sheet
    Sheets(Warning).Visible = xlSheetVisible
    
    'Hide every sheet, except the warning sheet
    For Each Sh In Sheets
        If Sh.Name <> Warning Then
            Sh.Visible = xlSheetVeryHidden
        End If
    Next Sh
    
End Sub


Private Sub ShowAllSheets()


    'Declare the variable
    Dim Sh As Object
    
    'Display every sheet, except the warning sheet
    For Each Sh In Sheets
        If Sh.Name <> Warning Then
            Sh.Visible = xlSheetVisible
        End If
    Next Sh
    
    'Hide the warning sheet
    Sheets(Warning).Visible = xlSheetVeryHidden
    
End Sub


Private Function IsLegalFilename(ByVal fname As String) As Boolean
    Dim BadChars As Variant
    Dim i As Long
    If Len(fname) > 218 Then
        IsLegalFilename = False
        Exit Function
    Else
        BadChars = Array("\", "/", "<", ">", "?", "[", "]", ":", "|", "*", """")
        fname = GetFileName(fname)
        For i = LBound(BadChars) To UBound(BadChars)
            If InStr(1, fname, BadChars(i)) > 0 Then
                IsLegalFilename = False
                Exit Function
            End If
        Next i
    End If
    IsLegalFilename = True
End Function


Private Function GetFileName(ByVal FullName As String) As String
    Dim i As Long
    For i = Len(FullName) To 1 Step -1
        If Mid(FullName, i, 1) = Application.PathSeparator Then Exit For
    Next i
    GetFileName = Mid(FullName, i + 1)
End Function

Everything that I've tried before would always return an error: "Ambiguous Name detected"

2. Disable printing of workbook and its sheets



Thank you for taking the time to read this and I'm really grateful for any advice/help. :)
Please let me know if there's any other info that I can provide to help!
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Forum statistics

Threads
1,222,567
Messages
6,166,835
Members
452,077
Latest member
hufflefry

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top