Make your Custom Addin

 Make your Custom Addin


Download VBA Code Notepad File - Click here

Download Excel Practice File - Click here

Download Addin - Click here

Copy VBA Code here

Option explicit

Sub Hide_Data()

        Selection.NumberFormat = ";;;"

End Sub

Sub Show_Data()

    Selection.NumberFormat = "General"

End Sub

Sub Hide_Columns()

   Selection.EntireColumn.Hidden = True

End Sub

Sub Show_Columns()

    Selection.EntireColumn.Hidden = False

End Sub

Sub Hide_Rows()

    Selection.EntireRow.Hidden = True

End Sub

Sub Show_Rows()

Selection.EntireRow.Hidden = False

End Sub

Sub Remove_Formulas()

    Selection.Copy

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

   Application.CutCopyMode = False

End Sub

Sub LockData()

Application.ScreenUpdating = False

Dim Rng As Range

Dim LocateRow As Long

Dim LocateCol As Long

LocateRow = ActiveCell.Row

LocateCol = ActiveCell.Column

On Error GoTo ErrorHandler

ActiveSheet.Unprotect Password:="guruji"

Cells.Select

Selection.Locked = False

'Jump to current selection

ActiveSheet.Cells(LocateRow, LocateCol).Select

Application.ScreenUpdating = True

Set Rng = Application.InputBox("Select Range of cells to Lock Data", "Range Selection", , , , , , 8)

Application.ScreenUpdating = False

Rng.Locked = True

'Also Locking formula cells

Selection.FormulaHidden = True

ActiveSheet.Protect Password:="guruji"

ErrorHandler:

If Err.Number = 424 Then

Err.Clear

End If

If Err.Number = 1004 Then

MsgBox "This sheet is already Protected with Custom Password Please Unlock First with Custom Password Option", , "Created by guruji"

Err.Clear

ActiveSheet.Cells(LocateRow, LocateCol).Select

End If

Application.ScreenUpdating = True

End Sub

Sub LockDataCustomPasword()

101:

Application.ScreenUpdating = False

Dim Rng As Range

Dim X As String

Dim LocateRow As Long

Dim LocateCol As Long

LocateRow = ActiveCell.Row

LocateCol = ActiveCell.Column

On Error GoTo ErrorHandler

Cells.Select

Selection.Locked = False

'Jump to current selection

ActiveSheet.Cells(LocateRow, LocateCol).Select

Application.ScreenUpdating = True

Set Rng = Application.InputBox("Select Range of cells to Lock Data", "Range Selection", , , , , , 8)

Application.ScreenUpdating = False

Rng.Locked = True

'Also Locking formula cells

Selection.FormulaHidden = True

    X = InputBox("Enter your Password to Lock Data.", "Password Required")

If StrPtr(X) = 0 Then

  'Cancel pressed

   Exit Sub

ElseIf X = "" Then

   MsgBox "Please enter a password"

   GoTo 101:

Else

  ActiveSheet.Protect Password:=X

    MsgBox "Selected Data Locked"

   'Password is stored in the variable "x"

End If

ErrorHandler:

If Err.Number = 424 Then

Err.Clear

End If

If Err.Number = 1004 Then

MsgBox "This sheet is already Protected please Unlock First", , "Created by guruji"

Err.Clear

ActiveSheet.Cells(LocateRow, LocateCol).Select

End If

Application.ScreenUpdating = True

End Sub

Sub UnLockData()

On Error GoTo Errh:

Application.ScreenUpdating = False

ActiveSheet.Unprotect Password:="guruji"

Application.ScreenUpdating = True

Errh:

If Err.Number = 1004 Then

MsgBox "This sheet is Protected with Custom Password Please Unlock with Custom Password Option", , "Created by guruji"

Err.Clear

End If

End Sub

Sub UnLockDataCustPassword()

101:

On Error GoTo Errh:

Application.ScreenUpdating = False

Dim X As String

X = InputBox("Enter your password to unlock data.", "Password Required")

If StrPtr(X) = 0 Then

  'Cancel pressed

   Exit Sub

ElseIf X = "" Then

   MsgBox "Please enter a password"

   GoTo 101:

Else

  ActiveSheet.Unprotect Password:=X

  MsgBox "Unlock successfully"

End If

Application.ScreenUpdating = True

Errh:

If Err.Number = 1004 Then

Err.Clear

MsgBox "You have entered a wrong password,", , "Created by guruji"

End If

End Sub

Download VBA Code Notepad File - Click here

Download Excel Practice File - Click here

Download Addin - Click here





कोई टिप्पणी नहीं

टिप्पणी: केवल इस ब्लॉग का सदस्य टिप्पणी भेज सकता है.

Send Multiple Emails From Excel | Send Bulk Mail from Excel Sheet with Attachment in One Click

Send Multiple Emails From Excel | Send Bulk Mail from Excel Sheet with Attachment in One Click Download VBA Code Notepad file - Click here D...

Blogger द्वारा संचालित.