Check alle échte Black Friday-deals Ook zo moe van nepaanbiedingen? Wij laten alleen échte deals zien
Toon posts:

Wachtwoord macro's

Pagina: 1
Acties:

woensdag 6 april 2011 08:13

Acties:

Verwijderd

Topicstarter
Beste,

ik heb in een Excel bestand verschillende macro's opgenomen. Het blad moet door diverse mensen worden uitgevoerd. Eén persoon doet de verwerking. Hij moet alle beveiligingen kunnen opheffen met één handeling. Daar ik niet wil dat andere gebruikers de macro's kunnen uitvoeren heb ik er een wachtwoord voorgezet. Dit werkt doch het probleem is dat je bij het intypen van het wachtwoord ook geschreven ziet staan.

Ik gebruikte volgende code:

'Public Sub MyMacro()
Const PWORD As String = "Wachtwoord"
Dim response As String
Dim msg As String
msg = "Voer wachtwoord in:"
Do
response = Application.InputBox(Prompt:=msg, _
Title:="Password", Type:=2)
If response = CStr(False) Then Exit Sub 'Cancelled
msg = "Incorrect!" & vbNewLine & "Voer opnieuw wachtwoord in:"
Loop Until response = PWORD

'Voer code in

Weet Iemand hoe ik Bvb. sterretjes kan geven bij invoeren wachtwoord???

Alvast met Dank!

woensdag 6 april 2011 08:16

Acties:
  • Poltergeist
  • Registratie: Oktober 2000
  • Laatst online: 22:22

Poltergeist

Met de inputbox kan dat niet. Dan zou je een userform moeten maken met een textbox, met de property passwordchar op *

woensdag 6 april 2011 08:40

Acties:

Verwijderd

Topicstarter
Dank je,
Hier heb ik niet zoveel ervaring in. Hoe doe je dit simpel???

woensdag 6 april 2011 13:57

Acties:

Verwijderd

Topicstarter
OPLOSSING:
'API functions to be used
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook 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 hHook 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

'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0


Private hHook As Long


Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String, lngBuffer As Long

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

strClassName = String$(256, " ")
lngBuffer = 255

If lngCode = HCBT_ACTIVATE Then 'A window has been activated

RetVal = GetClassName(wParam, strClassName, lngBuffer)

If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox

'This changes the edit control so that it display the password character *.
'You can change the Asc("*") as you please.
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If

End If

'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam

End Function

Function InputBoxDK(Prompt, Title) As String
Dim lngModHwnd As Long, lngThreadID As Long

lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)

hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

InputBoxDK = InputBox(Prompt, Title)
UnhookWindowsHookEx hHook

End Function
Sub Beveiligen()
'Public Sub MyMacro()
x = InputBoxDK("Uw wachtwoord a.u.b...", "Wachtwoord vereist.")

If x <> "wachtwoord" Then
MsgBox "Wachtwoord niet correct!...."
Exit Sub

End If

'Voer code in
' Beveiligen macro
' De macro is opgenomen op 5/04/2011 door hulsmans.
'
' Sneltoets: CTRL+SHIFT+B
' ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 12 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 11 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 10 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 09 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 08 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 07 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 06 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 05 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 04 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 03 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 02 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AFDRUK 01 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("DECEMBER 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("NOVEMBER 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("OKTOBER 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("SEPTEMBER 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("AUGUSTUS 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("JULI 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("JUNI 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("MEI 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("APRIL 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("MAART 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("FEBRUARI 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("JANUARI 2012").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False

End Sub
Sub OphefBeveiliging macro()
'Public Sub MyMacro()
x = InputBoxDK("Uw wachtwoord a.u.b...", "Wachtwoord vereist.")

If x <> "wachtwoord" Then
MsgBox "Wachtwoord niet correct!...."
Exit Sub

End If

'Voer code in
' OphefBeveiligingDAO Macro
' De macro is opgenomen op 5/04/2011 door hulsmans.
'
' Sneltoets: CTRL+SHIFT+W
'
ActiveSheet.Unprotect
Sheets("JANUARI 2012").Select
ActiveSheet.Unprotect
Sheets("FEBRUARI 2012").Select
ActiveSheet.Unprotect
Sheets("MAART 2012").Select
ActiveSheet.Unprotect
Sheets("APRIL 2012").Select
ActiveSheet.Unprotect
Sheets("MEI 2012").Select
ActiveSheet.Unprotect
Sheets("JUNI 2012").Select
ActiveSheet.Unprotect
Sheets("JULI 2012").Select
ActiveSheet.Unprotect
Sheets("AUGUSTUS 2012").Select
ActiveSheet.Unprotect
Sheets("SEPTEMBER 2012").Select
ActiveSheet.Unprotect
Sheets("OKTOBER 2012").Select
ActiveSheet.Unprotect
Sheets("NOVEMBER 2012").Select
ActiveSheet.Unprotect
Sheets("DECEMBER 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 01 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 02 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 03 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 04 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 05 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 06 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 07 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 08 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 09 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 10 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 11 2012").Select
ActiveSheet.Unprotect
Sheets("AFDRUK 12 2012").Select
ActiveSheet.Unprotect
End Sub

[ Voor 99% gewijzigd door Verwijderd op 28-11-2011 20:53 ]

Reageer

Apple iPhone 17 LG OLED evo G5 Google Pixel 10 Samsung Galaxy S25 Star Wars: Outlaws Nintendo Switch 2 Apple AirPods Pro (2e generatie) Sony PlayStation 5 Pro

Tweakers is onderdeel van DPG Media B.V.
Alle rechten voorbehouden - Auteursrecht © 1998 - 2025 • Hosting door TrueFullstaq