Disable Copy Paste Excel File to Another Computer - Excel VBA

Kadang kita membuat file excel namun takut disalah gunakan oleh orang yang tidak bertanggung jawab dengan mengkopy isi sheet bahkan mengkopy file excel kita

Ada beberapa tip untuk mengamankan file anda diantaranya adalah Mendisable file excel dicopy ke Computer lain

File bias dicopy ke computer lain namun file akan ditolak dan langsung terhapus bila seri no tidak sesuai dengan kode number serial yang dipasang di file tersebut sehingga file excel anda akan tetap aman

Untuk mengetahui no Serial Hardisk dari sebuah computer pastekan kode berikut pada sebuah modul

Sub Cek_noHardis ()
Sheets("Sheet1").Range("b1").Value = CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber
End Sub

Dan Kemudian Kode yang muncul akan kita pasang pada file excel kita sesuai no seri hardis untuk computer yang bisa mengakses file tersebut

Pastekan kode pada Workbook sesuaikan no seri nya

Private Sub Workbook_Open()
Dim oFSO As Object
Dim drive As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set drive = oFSO.GetDrive("C:\")
If drive.SerialNumber <> 408299609 Then
Application.Run "Killy"
Set oFSO = Nothing
Set drive = Nothing
End If
End Sub

Pastekan pada modul

Sub Killy()
MsgBox "Illegal Copy ", vbExclamation + vbMsgBoxRight
Application.DisplayAlerts = False
ThisWorkbook.ChangeFileAccess xlReadOnly
Kill ThisWorkbook.FullName
ThisWorkbook.Close False
Application.DisplayAlerts = False
End Sub

Untuk mendisabel copy paste dilembar excel pastekan juga kode berikut pada wookbook

Private Sub Workbook_Activate()Application.CutCopyMode = FalseApplication.OnKey "^c", ""Application.CellDragAndDrop = FalseEnd Sub

Private Sub Workbook_Deactivate()Application.CellDragAndDrop = TrueApplication.OnKey "^c"Application.CutCopyMode = FalseEnd Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)Application.CutCopyMode = FalseApplication.OnKey "^c", ""Application.CellDragAndDrop = FalseEnd Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)Application.CellDragAndDrop = TrueApplication.OnKey "^c"Application.CutCopyMode = FalseEnd Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)Cancel = TrueMsgBox "Right click menu deactivated." & vbCrLf & _"Cannot copy or ''drag & drop''.", 16, "For this workbook:"End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)Application.CutCopyMode = FalseEnd Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)Application.OnKey "^c", ""Application.CellDragAndDrop = FalseApplication.CutCopyMode = FalseEnd Sub