Driesumdre
Gebruiker
- Lid geworden
- 19 mei 2011
- Berichten
- 29
Goedemorgen forumvriendjes
Ik ben aan het stoeien met een Macro, maar het wil me maar niet lukken.
Het gaat om een formulier waarin een akkoord gegeven moet worden door 1 van 2 personen. de 2 personen krijgen een wachtwoord om in het formulier het akkoord te kunnen geven.
Hiervoor ben ik internet af gaan speuren, maar ik kan maar niet vinden wat ik nodig heb. Ik kom wel een Code tegen waarmee ik verder zou kunnen komen, maar die loopt vast op een compileerfout. zie onderstaande code.
Als iemand die compileerfout op kan lossen kom ik misschien weer in de goede richting.
de "Public Const sMypassword..." is het probleem in deze code
Option Explicit
Public OK As Boolean
Public Const sMyPassWord As String = "test"
Function GetPassWord(Title As String)
'---------------------------------------------------------------------------------------
' Procedure : GetPassWord
' DateTime : 4/02/02 19:04
' Author : Ivan F Moala
' Purpose : Creates a Dynamic UF to Test for aPassword
' : so there is no need to create one.
'---------------------------------------------------------------------------------------
Dim TempForm
Dim NewTextBox As MSForms.TextBox
Dim NewCommandButton1 As MSForms.CommandButton
Dim NewCommandButton2 As MSForms.CommandButton
Dim x As Integer
' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
' Create a Temp UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
' Add a TextBox
Set NewTextBox = TempForm.Designer.Controls.Add("forms.textbox.1")
With NewTextBox
.PasswordChar = "*"
.Width = 140
.Height = 20
.Left = 48
.Top = 18
End With
' Add the OK button
Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 66
.Left = 126
.Top = 66
End With
' Add the Cancel button
Set NewCommandButton2 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 66
.Left = 30
.Top = 66
End With
' Add event-handler subs for the CommandButtons & Userform
With TempForm.CodeModule
x = .CountOfLines
.insertlines x + 1, "Sub CommandButton2_Click()"
.insertlines x + 2, "OK = False: Unload Me"
.insertlines x + 3, "End Sub"
.insertlines x + 4, "Sub CommandButton1_Click()"
.insertlines x + 5, "If TextBox1 = sMyPassWord Then OK = True: Unload Me"
.insertlines x + 6, "End Sub"
.insertlines x + 7, "Private Sub UserForm_Initialize()"
.insertlines x + 8, "Application.EnableCancelKey = xlErrorHandler"
.insertlines x + 9, "End Sub"
End With
' Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = 240
.Properties("Height") = 120
NewCommandButton1.Left = 46
NewCommandButton2.Left = 126
End With
' Show the form
VBA.UserForms.Add(TempForm.Name).Show
' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
' Pass the Variable back to the calling procedure
GetPassWord = OK
End Function
Sub ThisIsHowToUseIt()
'>>> This is the Main line <<<<br>Dim OKToProceed As Variant
OKToProceed = GetPassWord("Password Entry")
If OKToProceed = False Then End
'>>>-----------------------<<<<p>'>>> Your routine goes here <<<<p>MsgBox "My routine is running now"
End Sub
Ik ben aan het stoeien met een Macro, maar het wil me maar niet lukken.
Het gaat om een formulier waarin een akkoord gegeven moet worden door 1 van 2 personen. de 2 personen krijgen een wachtwoord om in het formulier het akkoord te kunnen geven.
Hiervoor ben ik internet af gaan speuren, maar ik kan maar niet vinden wat ik nodig heb. Ik kom wel een Code tegen waarmee ik verder zou kunnen komen, maar die loopt vast op een compileerfout. zie onderstaande code.
Als iemand die compileerfout op kan lossen kom ik misschien weer in de goede richting.
de "Public Const sMypassword..." is het probleem in deze code
Option Explicit
Public OK As Boolean
Public Const sMyPassWord As String = "test"
Function GetPassWord(Title As String)
'---------------------------------------------------------------------------------------
' Procedure : GetPassWord
' DateTime : 4/02/02 19:04
' Author : Ivan F Moala
' Purpose : Creates a Dynamic UF to Test for aPassword
' : so there is no need to create one.
'---------------------------------------------------------------------------------------
Dim TempForm
Dim NewTextBox As MSForms.TextBox
Dim NewCommandButton1 As MSForms.CommandButton
Dim NewCommandButton2 As MSForms.CommandButton
Dim x As Integer
' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
' Create a Temp UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
' Add a TextBox
Set NewTextBox = TempForm.Designer.Controls.Add("forms.textbox.1")
With NewTextBox
.PasswordChar = "*"
.Width = 140
.Height = 20
.Left = 48
.Top = 18
End With
' Add the OK button
Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 66
.Left = 126
.Top = 66
End With
' Add the Cancel button
Set NewCommandButton2 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 66
.Left = 30
.Top = 66
End With
' Add event-handler subs for the CommandButtons & Userform
With TempForm.CodeModule
x = .CountOfLines
.insertlines x + 1, "Sub CommandButton2_Click()"
.insertlines x + 2, "OK = False: Unload Me"
.insertlines x + 3, "End Sub"
.insertlines x + 4, "Sub CommandButton1_Click()"
.insertlines x + 5, "If TextBox1 = sMyPassWord Then OK = True: Unload Me"
.insertlines x + 6, "End Sub"
.insertlines x + 7, "Private Sub UserForm_Initialize()"
.insertlines x + 8, "Application.EnableCancelKey = xlErrorHandler"
.insertlines x + 9, "End Sub"
End With
' Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = 240
.Properties("Height") = 120
NewCommandButton1.Left = 46
NewCommandButton2.Left = 126
End With
' Show the form
VBA.UserForms.Add(TempForm.Name).Show
' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
' Pass the Variable back to the calling procedure
GetPassWord = OK
End Function
Sub ThisIsHowToUseIt()
'>>> This is the Main line <<<<br>Dim OKToProceed As Variant
OKToProceed = GetPassWord("Password Entry")
If OKToProceed = False Then End
'>>>-----------------------<<<<p>'>>> Your routine goes here <<<<p>MsgBox "My routine is running now"
End Sub