AW: Makro schützen...
06.10.2008 14:40:00
mumpel
Hallo!
Du meinst also, dass Kennwort durch Sternchen verbergen? Dass geht nur per API. Zuerst den folgenden API-Code in ein allgemeines Modul. Code stammt von Nepumuk.
Option Explicit
Private Declare Function GetVbaProjekt Lib "vba332.dll" Alias "EbGetExecutingProj" _
(hVBA As Long) As Long
Private Declare Function GetFunktionsnummerString Lib "vba332.dll" Alias "TipGetFunctionId" _
(ByVal hVBA As Long, ByVal strFuncNameUnicode As String, strFunktionsnummer As String) As Long
Private Declare Function GetFunktionsnummerLong Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" _
(ByVal hVBA As Long, ByVal strFunktionsnummer As String, hlngFunction As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) _
As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd 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 GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Private Enum Constant
EM_SETPASSWORDCHAR = &HCC
GW_CHILD = 5
GW_HWNDFIRST = 0
GW_HWNDNEXT = 2
End Enum
Private hlngTimerKennung As Long
Private Function PasswortHolen(Optional Beschriftung As String) As String
If Beschriftung = "" Then Beschriftung = "Geben sie ihr Passwort ein!"
TimerSetzen
PasswortHolen = InputBox(Beschriftung)
End Function
Private Sub Passwortchar()
Dim hwnd&, hwnd1&, lngRück&, Klasse$
Dim Stil As Long
hwnd = FindWindow("#32770", "Microsoft Excel")
hwnd1 = GetWindow(hwnd, GW_CHILD)
Do
Klasse = String(255, 0)
lngRück = GetClassName(hwnd1, Klasse, 250)
Klasse = Left$(Klasse, InStr(1, Klasse, Chr(0)) - 1)
If LCase(Klasse) = "edit" Then SendMessageBynum hwnd1, EM_SETPASSWORDCHAR, 42, 0
hwnd1 = GetWindow(hwnd1, GW_HWNDNEXT)
Loop While hwnd1 <> 0
End Sub
Private Sub TimerSetzen()
hlngTimerKennung = SetTimer(0, 0, 1000, AddressOf ApiTimer1)
If hlngTimerKennung = 0 Then MsgBox "Fehler beim Initialisieren des Timers"
End Sub
Private Sub TimerZerstören()
If hlngTimerKennung <> 0 Then KillTimer 0, hlngTimerKennung
End Sub
Private Sub ApiTimer1(ByVal hwndOwner&, ByVal lngWindowMessage&, ByVal hlngRückTimerKennung&, _
ByVal lngTickCount&)
TimerZerstören
Passwortchar
End Sub
Private Function GetFuncAdress&(strFunktion$)
Dim hVBA&, lngRück&, strFunktionsnummer$
Dim hlngFunction&, strFuncNameUnicode$
strFuncNameUnicode = StrConv(strFunktion, vbUnicode)
GetVbaProjekt hVBA
If hVBA <> 0 Then
lngRück = GetFunktionsnummerString(hVBA, strFuncNameUnicode, strFunktionsnummer)
If lngRück = 0 Then
lngRück = GetFunktionsnummerLong(hVBA, strFunktionsnummer, hlngFunction)
If lngRück = 0 Then GetFuncAdress = hlngFunction
End If
End If
End Function
Code eingefügt mit VBA in HTML 1.2 ( Hilfe zum Programm)size>
Dann den folgenden Code nehmen.
Sub test()
If PasswortHolen <> "Kennwort" Then Exit Sub
'Hier Dein Code
End Sub
Gruß, René