Supportnet / Forum / Tabellenkalkulation
Visual Basic/Eingabemaske
Frage
Hallo,
habe schon einige Beiträge gefunden, in denen das Thema behandelt wird und dort wird das oft am Beispiel erklärt. Ich habe noch keine wirkliche Ahnung von VisualBasic (VB) und würde mich freuen, wenn mir jemand eine Beispieldatei aus Excel per Mail senden könnte, in der so die grundlegenden Dinge mit VB und Eingabemasken gemacht werden, damit ich mich da mal nen bißchen durchwurschteln kann :)
Vielen Dank schonmal
Martin
paule_der_baggerfahrer (ät) hotmail.com
Antwort 1 von micha123abc
hallo martin
zum anfang was ein einfaches,eingabemaske mit sternchen als platzhalter
gruss micha123abc
Private Sub cmbPass_Click()
Range("E1").Value = PasswortHolen(Range("B1").Value)
End Sub
´*************************************
´* AddressOf
´* Ausgeknobelt von K. Getz und M. Kaplan
´*************************************
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
´*************************************
´* Der Rest ist von mir Michael Schwimmer
´*************************************
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 Const EM_SETPASSWORDCHAR = &HCC
Private Const GW_CHILD = 5
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
´************************************
Private hlngTimerKennung As Long
Public 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
End If
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
´*************************************
´* AddressOf
´* Ausgeknobelt von K. Getz und M. Kaplan
´*************************************
Public 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
zum anfang was ein einfaches,eingabemaske mit sternchen als platzhalter
gruss micha123abc
Private Sub cmbPass_Click()
Range("E1").Value = PasswortHolen(Range("B1").Value)
End Sub
´*************************************
´* AddressOf
´* Ausgeknobelt von K. Getz und M. Kaplan
´*************************************
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
´*************************************
´* Der Rest ist von mir Michael Schwimmer
´*************************************
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 Const EM_SETPASSWORDCHAR = &HCC
Private Const GW_CHILD = 5
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
´************************************
Private hlngTimerKennung As Long
Public 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
End If
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
´*************************************
´* AddressOf
´* Ausgeknobelt von K. Getz und M. Kaplan
´*************************************
Public 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

