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





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

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

How To Convert Data in Columns into Rows in Excel Document

How To Convert Data in Columns into Rows in Excel Document Download Notepad file - Clickhere Copy code here: Function SplitCellToRows(CellVa...

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