• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Run-Time error 50289 Hatası

  • Konbuyu başlatan Konbuyu başlatan neo
  • Başlangıç tarihi Başlangıç tarihi

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
 
:dua: İyi geceler arkadaşlar

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

Sayılarımla
 
:agla:

Sn leventm

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

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

run-time 1004 Methot Sheets of Global Failed
 
:hey: Merhaba

Sn zerige bunu tercüme edebileceğimi zannetmiyorum
 
Tercüme etmeye çalıştım ama ben de içinden çıkamadım :)

Çevirebilecek birileri çıkar elbet. :hey:
 
:dua: :kafa: Merhaba

Sn leventm bu sorunu halen çözemedim yardımlarınızı bekliyorum :dua:
 
VBA kodlarınızdaki şifreyi kaldırırsanız sorununuz çözülür.
 
Geri
Üst