PDA

View Full Version : Solved: How to Edit this Macro code



Esmatullah
12-07-2012, 09:12 AM
I have used this Macro code in my Excel File. Now i want to edit this code to able i can change it password with a button to load a forum contains Old password, New Password and Confirm New Password fields.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B7:D9")) Is Nothing Then Exit Sub
ActiveSheet.Unprotect Password:="Password"
Target.Locked = True
ActiveSheet.Protect Password:="Password"
End Sub

Teeroy
12-07-2012, 07:11 PM
You can't do that easily with a hard coded password. It would be better to first put put the password in a custom document property or in a cell on an xlveryhidden sheet and reference it, then write another macro to change the password. e.g if you have the password on a sheet called "HiddenSheet" in cell A1 (with inputbox):
Sub password_change()

response = InputBox("Old Password", "Password Change")
If response <> Sheets("HiddenSheet").Range("A1").Value Then
MsgBox "Incorrect Password"
Exit Sub
End If
response = InputBox("New Password", "Password Change")
temp = Sheets("HiddenSheet").Range("A1").Value
Sheets("HiddenSheet").Range("A1").Value = response
response = InputBox("Retype New Password", "Password Change")
If response <> Sheets("HiddenSheet").Range("A1").Value Then
MsgBox "Passwords do not match. Password change failed"
Sheets("HiddenSheet").Range("A1").Value = temp
End If
End Sub

Esmatullah
12-07-2012, 11:17 PM
ok it was beautiful but how i can link my macro Password part that i post with the cell A1 of HiddenSheet. And can you do that when i type pass in your macro msg box appear like ****

Teeroy
12-08-2012, 12:30 AM
Are all sheets protected? Or just a couple?

Teeroy
12-08-2012, 01:11 AM
I don't take credit for the majority of this code (I barely understand it :think:, but can use it). It comes from http://www.mrexcel.com/forum/excel-questions/278267-password-protection.html. (http://www.mrexcel.com/forum/excel-questions/278267-password-protection.html)

Try:

Private Declare Function CallNextHookEx Lib "user32" (ByVal mySysHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal mySysHook As Long) As Long

Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private mySysHook As Long

Public Function InPutBoxMask(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
'Standard Module Code, like: Module1.
'Code for new InPutBox called: InPutBoxMask!
Dim myHandle&, myProcID&

myProcID = GetCurrentThreadId
myHandle = GetModuleHandle(vbNullString)
mySysHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, myHandle, myProcID)

'Build new InPutBox that works just like the Regular InPutBox
'only it masks the visible User InPut from view!
'Just replace "InPutBox" with "InPutBoxMask" in your code!
'Syntax to use: returnName = InPutBoxMask(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
InPutBoxMask = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx mySysHook
End Function

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Standard Module Code, like: Module1.
'Define my system hook!
Dim myInPutLine$
Dim myInPutHold&
Dim myClassNm As Variant

If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(mySysHook, lngCode, wParam, lParam)
Exit Function
End If

myInPutLine = String$(256, " ")
myInPutHold = 255

If lngCode = HCBT_ACTIVATE Then
myClassNm = GetClassName(wParam, myInPutLine, myInPutHold)

If Left$(myInPutLine, myClassNm) = "#32770" Then
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If

CallNextHookEx mySysHook, lngCode, wParam, lParam
End Function

Sub password_change()

response = InPutBoxMask("Old Password", "Password Change")
If response <> Sheets("HiddenSheet").Range("A1").Value Then
MsgBox "Incorrect Password"
Exit Sub
End If
response = InPutBoxMask("New Password", "Password Change")
temp = Sheets("HiddenSheet").Range("A1").Value
Sheets("HiddenSheet").Range("A1").Value = response
response = InPutBoxMask("Retype New Password", "Password Change")
If response <> Sheets("HiddenSheet").Range("A1").Value Then
MsgBox "Passwords do not match. Password change failed"
Sheets("HiddenSheet").Range("A1").Value = temp
Exit Sub
End If
'unprotect existing sheets using Temp as password
'reprotect sheets using Sheets("HiddenSheet").Range("A1").Value as password
End Sub

Teeroy
12-08-2012, 01:19 AM
I forgot the change to your original code:


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B7:D9")) Is Nothing Then Exit Sub
ActiveSheet.Unprotect Password:=Sheets("HiddenSheet").Range("A1").Value
Target.Locked = True
ActiveSheet.Protect Password:=Sheets("HiddenSheet").Range("A1").Value
End Sub

Esmatullah
12-08-2012, 03:43 AM
Thanks all dear friends i have received the answer. thanks very much.
Please tell how i can disable sheet deleting that no one can delete it