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 Hardis 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 = False

Application.OnKey "^c", ""

Application.CellDragAndDrop = False

End Sub

Private Sub Workbook_Deactivate()

Application.CellDragAndDrop = True

Application.OnKey "^c"

Application.CutCopyMode = False

End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)

Application.CutCopyMode = False

Application.OnKey "^c", ""

Application.CellDragAndDrop = False

End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)

Application.CellDragAndDrop = True

Application.OnKey "^c"

Application.CutCopyMode = False

End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Cancel = True

MsgBox "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 = False

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

Application.OnKey "^c", ""

Application.CellDragAndDrop = False

Application.CutCopyMode = False

End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)

Application.CutCopyMode = False

End Sub

Selamat Mencoba

Semoga bermanfaat