Çalışmamda 2 Ad _Auto Open Nasıl Çalışır

[neo]

:hey: herkese merhaba dostlar

Yapmış olduğum çalışmada , Modül 2'de ve Mpdül 3'te Auto Open Var Dosyayı açtığımda Auto Open 'la ilgili bir hata veriyor bu sorunun bir çözümü varmıdır. Yardımlarınız için teşekurederim saygılarımla

Not
Dosyam yaklaşık 12 MB olduğundan gönderemiyorum kodları arzu ederseniz gönderebilirim

 

[Haluk]

Bir projede aynı isimde birden fazla prosedur olmaz.

Bunların ikisi de Autpen ise, birinin adını değiştirin ve öbürünün içinden çağırın.

 

[neo]

:hey: Merhabalar

bu iki Auto _Open makrosunu birleştiremedim yardımcı olurmusunuz
doslar

1- )

Public MyUser As String
Public MyPass As String
Sub Autpen()
Dim UserArr

UserArr = Array("Admın", "Admın_1", "Admın_2")

Select Case Format(Date, "w")
Case 1 To 3
MyPassword = "111111"
Case 4 To 7
MyPassword = "222222"
End Select

ThisWorkbook.IsAddin = True

MyPasswBox

If MyPass <> "" And MyUser <> "" Then
For i = LBound(UserArr) To UBound(UserArr)
If MyUser = UserArr(i) And MyPass = MyPassword Then
ThisWorkbook.IsAddin = False
MsgBox UserArr(i) & ", girişiniz onaylandı !", _
vbInformation, "Bilgi..."
Exit Sub
End If
Next
MsgBox "Kullanıcı adı ve şifrenizi kontrol edin !", vbCritical, "Dikkat !"
End If
End Sub
'
Sub MyPasswBox()
Dim PassWForm

Set PassWForm = ThisWorkbook.VBProject.VBComponents.Add(3)
PassWForm.Properties("Width") = 200
PassWForm.Properties("Height") = 120
PassWForm.Properties("Caption") = "Þifre girişi !"

Set NewLabel = PassWForm.Designer.Controls.Add("forms.Label.1")
With NewLabel
.Width = 50
.Height = 18
.Left = 8
.Top = 22
.Caption = " Kullanıcı Adı :"
End With

Set NewLabel = PassWForm.Designer.Controls.Add("forms.Label.1")
With NewLabel
.Width = 50
.Height = 18
.Left = 8
.Top = 44
.Caption = " Þifre :"
End With

Set NewTextBox = PassWForm.Designer.Controls.Add("forms.TextBox.1")
With NewTextBox
.Width = 120
.Height = 18
.Left = 60
.Top = 20
.PasswordChar = "*"
.ForeColor = vbRed
End With

Set NewTextBox = PassWForm.Designer.Controls.Add("forms.TextBox.1")
With NewTextBox
.Width = 120
.Height = 18
.Left = 60
.Top = 42
.PasswordChar = "*"
.ForeColor = vbRed
End With

Set NewCommandButton1 = PassWForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "Vazgeç"
.Height = 18
.Width = 50
.Left = 70
.Top = 72
End With

Set NewCommandButton2 = PassWForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Tamam"
.Height = 18
.Width = 50
.Left = 130
.Top = 72
End With

With PassWForm.CodeModule
x = .CountOfLines
.InsertLines x + 1, "Sub CommandButton1_Click()"
.InsertLines x + 2, "Unload Me"
.InsertLines x + 3, "End Sub"
.InsertLines x + 4, "Sub CommandButton2_Click()"
.InsertLines x + 5, "MyUser = TextBox1"
.InsertLines x + 6, "MyPass = TextBox2"
.InsertLines x + 7, "Unload Me"
.InsertLines x + 8, "End Sub"
.InsertLines x + 9, "Sub UserForm_Activate()"
.InsertLines x + 10, "Me.SpecialEffect=3"
.InsertLines x + 11, "End Sub"
End With
VBA.UserForms.Add(PassWForm.Name).Show
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=PassWForm

End Sub


2- )

Const strTxtFile As String = "C:\Sirket.txt"
Const MyCheckVal As Long = 123456
'
Sub Autpen()
Dim InputData As Variant
Dim FileNum As Long
Dim x As Integer
FileNum = FreeFile
If Dir(strTxtFile) <> Empty Then
Open strTxtFile For Input As FileNum
x = x + 1
Do While Not EOF(FileNum)
Line Input #FileNum, InputData
If Left(InputData, 6) <> MyCheckVal Then GoTo NoGo:
If x = 1 Then Exit Sub
Loop
Close FileNum
ThisWorkbook.IsAddin = False
Else
NoGo:
ThisWorkbook.IsAddin = True
MsgBox "Kayitli kullanici degilsiniz....", vbCritical, "Kullanicinin dikkatine !"
ThisWorkbook.Close SaveChanges:=False
End If
End Sub

 

[neo]

:dua: Yardım cı olacak kimse yok mu arkadaşlar

 

[zafer]

Merhaba

1. auto open çalıştıktan sonra 2. için başka bir isim verip

1. auto open makrosuna bağlasanınız.


sub auto_open()
...
...

2 makro
end sub

 

[balca]

Yada diğer yol;

sub a()
......
......
end sub

sub b()
.........
........
end sub

sub auto_open()
a
b
end sub

 

[neo]

:hihoho:

Dostlarım Çok teşekurederim dediğiniz gibi yaptım sorunum çözüldü

Saygılarımla,

 

[baydeniro]

Paylaşım için teşekkürler.