• DİKKAT

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

User Form İle Lisans Girme

Kodlarınızı aşağıdaki şekilde değiştirin. Her defasında numeric olmuyor bu numara.
Kod: 
Private Sub Workbook_Open()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")

If IsNumeric(Left(Surucu.SerialNumber, 1)) = False Then
    UserForm1.TextBox1.Text = Mid(Surucu.SerialNumber, 2, Len(Surucu.SerialNumber) - 1)
Else
    UserForm1.TextBox1.Text = Surucu.SerialNumber
End If
If Surucu.SerialNumber = -564566904 Then
MsgBox " Kayıtlı Kullanıcı Olduğunuz İçin Teşekkür Ederiz."
Exit Sub
Else
MsgBox "Geçersiz Lisans. Lütfen Geçerli Bir Lisans Anahtarı Giriniz!"
UserForm1.Show
End If
End Sub


Kod: 
Private Sub CommandButton1_Click()
Dim FSO As Object, Surucu As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
Seri = Surucu.SerialNumber
If IsNumeric(Left(Surucu.SerialNumber, 1)) = False Then
    UserForm1.TextBox1.Text = Mid(Surucu.SerialNumber, 2, Len(Surucu.SerialNumber) - 1)
Else
    UserForm1.TextBox1.Text = Surucu.SerialNumber
End If
Set Surucu = Nothing
Set FSO = Nothing
End Sub
 
Son düzenleme:
Sayın Ömer Baran ve askfm, yardımlarınız için çok teşekkür ederim. Kodu şimdi deneyeceğim, sadece şunu sormak istiyorum; bu kod eğer serialin başında "-" işareti yoksa ilk rakam veya harf ne varsa onuda iptal edermi ? yoksa sadece "-" işaretinimi iptal edecek? bilgi amaçlı bir sorudur tekrardan çok teşekkür ederim.
 
Daha öncede sormuştum sorumu yinelemek istiyorum. Textbox'a girdiğim veriyi sabit kalacak şekilde nasıl kaydedebilirim her açılışta tekrar yazılmaması adına ?

Kaydet butonuna tanımladığım kod aşağıdadır, buna nasıl bir ekleme yapmam gerek veya başka bir kodlama nasıl olmalı?

Kod: 
Private Sub CommandButton2_Click()
i = TextBox2
If i = Empty Or i = TextBox1.Text Or i <> TextBox3.Text Then
MsgBox "Eksik Yada Hatalı Giriş. Lütfen Lisans Anahtarını Kontrol Ediniz!", , "UYARI GEÇERSİZ LİSANS"
ElseIf TextBox2.Value = Val(TextBox1.Value * 90) Then
MsgBox "Sayın " & Application.UserName & " Programınız Lisanslanmıştır. İyi Günlerde Kullanınız!", , "GEÇERLİ LİSANS"
Unload UserForm1
End If
End Sub

If i = Empty Or i = TextBox1.Text Or i <> TextBox3.Text Then yukarıdaki kodun bu kısmındaki TextBox3 ifadesi yerine *90 şartınıda değiştirebilirsek sorun tamamen çözüme kavuşmuş olacak.
 
Son düzenleme:
Sadece size açılabilecek bir sayfa ekler. Kullanıcı username ya da seri size ait ise o sayfa açık değilse gizli olur. O sayfaya kaydeder.
 
Sadece mantık yürüterek soruyorum, Unload UserForm1 yaptırımı gibi örneğin Save UserForm1 yada Save UserForm1.TextBox2 gibi bir koşul sağlayamaz mıyız ?
 
Değilkenler geçicidir. Hücreye txt ye ya da access e kayıt yapmanız gerekir.
 
__TR__' Alıntı:
Sayın Ömer Baran ve askfm, yardımlarınız için çok teşekkür ederim. Kodu şimdi deneyeceğim, sadece şunu sormak istiyorum; bu kod eğer serialin başında "-" işareti yoksa ilk rakam veya harf ne varsa onuda iptal edermi ? yoksa sadece "-" işaretinimi iptal edecek? bilgi amaçlı bir sorudur tekrardan çok teşekkür ederim.
Genişletmek için tıkla ...

Alternatif kod
kod seri numaranın önündeki eksi değer varsa siler

Kod: 
Sub CommandButton1_Click()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
UserForm1.TextBox1.Text = Math.Abs(FSO.GetDrive("C:").SerialNumber)
Set FSO = Nothing
End Sub
 
Yardımlarınız için çok teşekkür ederim. Şuan tek sorun Textboxa girilecek olan değerin kayıtlı kalması, eğer bu sorunda çözülürse istenilen sonuca ulaşılmış olacak.

Sayın askm, önerinizi gerçekleştirebilecek bir kod paylaşmanız mümkünmüdür?
 
Kodlar aşağıdadır.
BuÇalışmaKitabı kısmına
Kod: 
Private Sub Workbook_Open()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
Dim serino As String
If IsNumeric(Left(Surucu.SerialNumber, 1)) = False Then
serino = Mid(Surucu.SerialNumber, 2, Len(Surucu.SerialNumber) - 1)
UserForm1.TextBox1.Text = Mid(Surucu.SerialNumber, 2, Len(Surucu.SerialNumber) - 1)

Else
UserForm1.TextBox1.Text = Surucu.SerialNumber
serino = Surucu.SerialNumber
End If

If serino = 641351642 Then '564566904
    Sheets("Bilgi").Visible = True
Else
    Sheets("Bilgi").Visible = xlSheetVeryHidden
End If

If serino = Sheets("Bilgi").Range("A1").Value Then '564566904

MsgBox " Kayıtlı Kullanıcı Olduğunuz İçin Teşekkür Ederiz."
Exit Sub
Else
MsgBox "Geçersiz Lisans. Lütfen Geçerli Bir Lisans Anahtarı Giriniz!"
UserForm1.Show
End If
End Sub
Kaydet Butonu
Kod: 
Private Sub CommandButton2_Click()
i = TextBox2
If i = Empty Or i = TextBox1.Text Or i <> TextBox3.Text Then
MsgBox "Eksik Yada Hatalı Giriş. Lütfen Lisans Anahtarını Kontrol Ediniz!", , "UYARI GEÇERSİZ LİSANS"
ElseIf TextBox2.Value = Val(TextBox1.Value * 90) Then
Sheets("Bilgi").Visible = True
Sheets("Bilgi").Range("A1") = TextBox1.Value
Sheets("Bilgi").Range("B1") = Val(TextBox1.Value * 90)
MsgBox "Sayın " & Application.UserName & " Programınız Lisanslanmıştır. İyi Günlerde Kullanınız!", , "GEÇERLİ LİSANS"
Unload UserForm1
Sheets("Bilgi").Visible = xlSheetVeryHidden
End If
End Sub
 
Sayın askm, kodlarınızı denedim, kaydet butonunda sıkıntı var (kaydet butonu kayıt işlemi yapmıyor, textboxa değer giriliyor fakat işlem yapmıyor) ama mantığını anladım, yanlış değilse; siz seriali hücreye yazdırıp eğer seçilen hücrede belirlenen değer varsa kullanıma izin veriyor.

Hocam haala araştırmaya devam ediyorum, mümkünmü bilmiyorum ama eğer textbox içerisine kaydetmek mümkünse ilk tercihim bu eğer değilse son çare sizin yönteminizi kullanacağım. Yardımlarınız için çok teşekkür ederim.
 
Merhaba,

Ürettiğiniz kodu Textbox nesnesine kayıt edemezsiniz.

Vba kodları ile regedite yazdırabilirsiniz.
Vba kodları ile text dosyasına yazdırabilirsiniz.
Vba kodları ile dosyanın kod bölümüne yazdırabilirsiniz. (Ek güvenlik ayarı isteyecektir)

İşinize yararsa bu adımları araştırın.
 
Bilgi adında bir sayfa ekleyip denediniz mi. Mantık eğer sayfa sizin serial ise açılıyor. Yoksa gizli oluyor. Kayıt için de önce sayfa gözüküyor. Kayıt yapıp gizliyor.

Korhan Bey regedit ve kod kısmı ile ilgili örnek veya link verebilir misiniz. Googleden baktım bulamadım. Belki de yanlış ifade ile aradım.
 
Denedim hocam, bende Korhan beyin mesajını gördükten sonra nette ve form içersinde regedit ve txt ile alaklı örnek arayıp inceliyorum. Sorunsuz bir şekilde çalışan kod bulabilirsem buradan paylaşacağım.
 
Txt bulabiliriz. Ama regedit ve vba (özellikle vba ilk defa duyuyorum) telefondan bakarak bulamadım. Pc başında bakarak gerek.
 
VBA projesi kilitli olacağından vba modulune yazdırma işe yaramayacaktır.
 
Kod: 
Private Sub CommandButton1_Clic()
if TextBox1.Value + 100 Then
DeğerKaydet HCU, "ExelWeb\Forum", "mrXL", "ExcelWeb Forum Üyesi"
MsgBox "Kayıtlı Kullanıcı Olduğunuz için Teşekkür Ederim", , "Tebrikler!"
Unload Me
Else
MsgBox "Yanlış veya Eksik Şifre Girdinix. Tekrar Deneyiniz!", vbCritical, "Şifre Hatası"
TextBox1 = ""
TextBox1.SetFocus
End if
End Sub

İnternette yaptığım araştırmalar neticesinde şöyle bir kod buldum ama sanırım eksik yada hata var.

Kodun yapması gereken: HKEY_CURRENT_USER\ExelWeb\Forum anahtarı içinde mrXL adında yeni bir dizine değeri açacak ve bu dize değerine de ExcelWeb Forum Üyesi verisini kaydetmesi gerek.
 
Forumda örnekler var, aşağıdaki ifadelerle arama yapınız.

RegWrite
RegRead
 
Sayın askm rahatça kontrol edebilmesi adına bulduğum kodu buradan paylaşıyorum.

HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main dizinine yeni bir DWORD değeri oluşturup. Adı "ornek" değerini (1) yapak için kullanılan kodlama

Kaynak: Regstry'de Yeni Anahtar Oluşturma

Kayıt Ekleme Makrosu
Kod: 
Sub WriteReg()
    Dim WSH_Shell As Object
    RegKey = "HKCU\Software\Microsoft\Internet Explorer\Main\Ornek "
    Set WSH_Shell = CreateObject("WScript.Shell")
    WSH_Shell.RegWrite RegKey, 1, "REG_DWORD"
End Sub

Kayıt Silme Makrosu
Kod: 
Sub DelReg()
    Dim WSH_Shell As Object
    RegKey = "HKCU\Software\Microsoft\Internet Explorer\Main\Ornek "
    Set WSH_Shell = CreateObject("WScript.Shell")
    WSH_Shell.RegDelete RegKey
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst