Run-Time error 50289 Hatası

neo

Katılım
24 Ağustos 2004
Mesajlar
287
:agla: İyi Geceler

VBAProject e şifrelediğim zaman
Run-Time error 50289 Can't perform since the project is protected
hatası veriyor kodlar Aşağıda

Modul 1 deki kod :
Sub HDDSeriNo()
Dim FSO As Object, Surucu As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
Seri = Surucu.SerialNumber
MsgBox Surucu & "22222222" & Seri
Set Surucu = Nothing
Set FSO = Nothing
End Sub
Sub a()
MsgBox "_ _--Programa Hoşgeldiniz...", , "Güvenlik Kontrolu...."
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
If Surucu.SerialNumber = 442307598 Or Surucu.SerialNumber = 22222222 Or Surucu.SerialNumber = 33333333 Then
MsgBox " Güvenli Giriş Onaylandı...."
Application.Run "Sayfa_ac"
Exit Sub
Else
Application.Run "Sayfa_gizle"
ThisWorkbook.Save
Application.Quit
End If
End Sub

Sub Auto_Close()
Application.Run "Sayfa_gizle"
ThisWorkbook.Save
End Sub
Sub Sayfa_ac()
For i = 1 To Sheets.Count
Sheets(i).Visible = True
Next i
End Sub
Sub Sayfa_gizle()
For i = 2 To Sheets.Count
Sheets(i).Visible = False
Next i
End Sub
Sub kapa()
EnableControl 21, False ' cut
EnableControl 19, False ' copy
EnableControl 22, False ' paste
EnableControl 755, False ' pastespecial
Application.OnKey "^c", ""
Application.OnKey "^v", ""
Application.OnKey "+{DEL}", ""
Application.OnKey "+{INSERT}", ""
Application.CellDragAndDrop = False
End Sub
Sub AC()
EnableControl 21, True ' cut
EnableControl 19, True ' copy
EnableControl 22, True ' paste
EnableControl 755, True ' pastespecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub

Modül 2 deki kod:

Public MyUser As String
Public MyPass As String
'
Sub c()
Dim UserArr

UserArr = Array("Huseyin", "Turker", "RedKid")

Select Case Format(Date, "w")
Case 1 To 3
MyPassword = "sifre1"
Case 4 To 7
MyPassword = "sifre2"
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

Modul 3 teki kod:

Sub Auto_Open()
a
c
End Sub
 

neo

Katılım
24 Ağustos 2004
Mesajlar
287
:dua: İyi geceler arkadaşlar

bu sorunu halen çözemedim yardımlarınızı bekliyorum

Sayılarımla
 

neo

Katılım
24 Ağustos 2004
Mesajlar
287
:agla:

Sn leventm

Dediğiniz gibi değiştirdim ama aynı hatayı gene veriyor
 

neo

Katılım
24 Ağustos 2004
Mesajlar
287
Sn leventm

Ã?zür diliyorum bu sefer başka bir hata veriyor

run-time 1004 Methot Sheets of Global Failed
 

neo

Katılım
24 Ağustos 2004
Mesajlar
287
:hey: Merhaba

Sn zerige bunu tercüme edebileceğimi zannetmiyorum
 

mehmett

Altın Üye
Katılım
18 Mayıs 2005
Mesajlar
2,571
Excel Vers. ve Dili
Excel 2010 Türkçe
Tercüme etmeye çalıştım ama ben de içinden çıkamadım :)

Çevirebilecek birileri çıkar elbet. :hey:
 

neo

Katılım
24 Ağustos 2004
Mesajlar
287
:dua: :kafa: Merhaba

Sn leventm bu sorunu halen çözemedim yardımlarınızı bekliyorum :dua:
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
VBA kodlarınızdaki şifreyi kaldırırsanız sorununuz çözülür.
 
Üst