Arkadaslar hazirlanan bir excel dosyasinin sadece belli bir bilgisayarda calismasi nasil saglanabilir. Ornegin, bilgisayar IP numarasi veya Register numarasi gibi ozellikleri kullanarak ekteki dosyaya boyle bir kontrol koymak olanagi var mi ?
-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Baska Bilgisayarda Calismama
- Konbuyu başlatan baydeniro
- Başlangıç tarihi
- Katılım
- 31 Ocak 2007
- Mesajlar
- 228
- Excel Vers. ve Dili
- office xp tr
Declare Function GetVolumeInformationA Lib "kernel32" _
(ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
Sub SeriNumarasi()
Dim SerialNumber As Long
GetVolumeInformationA "C:\", vbNullString, 0, SerialNumber, _
0, 0, vbNullString, 0
Range("L1") = SerialNumber
End Sub
Sub auto_open()
Call SeriNumarasi
If Range("L1") = Range("L2") Then
Range("a1").Select
Exit Sub
End If
MsgBox "üzgünüm programı kullanamazsınız "
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Kodu olduğu gibi bir modüle kopyalayınız.
kod otomatik olarak L1 hücresine harddisk serinosunu yazar L2 hücresine aynı noyu kendiniz giriniz kod iki hücre birbirinle eşleşiyorsa kitap açılır aksi halde kapanır(hücre adreslerini kendinize göre değiştiriniz.)
(ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
Sub SeriNumarasi()
Dim SerialNumber As Long
GetVolumeInformationA "C:\", vbNullString, 0, SerialNumber, _
0, 0, vbNullString, 0
Range("L1") = SerialNumber
End Sub
Sub auto_open()
Call SeriNumarasi
If Range("L1") = Range("L2") Then
Range("a1").Select
Exit Sub
End If
MsgBox "üzgünüm programı kullanamazsınız "
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Kodu olduğu gibi bir modüle kopyalayınız.
kod otomatik olarak L1 hücresine harddisk serinosunu yazar L2 hücresine aynı noyu kendiniz giriniz kod iki hücre birbirinle eşleşiyorsa kitap açılır aksi halde kapanır(hücre adreslerini kendinize göre değiştiriniz.)
Son düzenleme:
Yardım
Sayın ileriexcel yeteneksizliğimi mazur görün lütfen. Yazdıklarınızı uyguladım ancak neden bilmiyorum uygulama çalışmadı. Ekteki dosyada KOD ve benim bilgisayarın Register numarası (Control Panel > System > General > Registered to numarası) yazılıdır. Acaba windows versiyon farklılığından dolayı mı olmuyor !!! İlginize teşekkürler.
Sayın ileriexcel yeteneksizliğimi mazur görün lütfen. Yazdıklarınızı uyguladım ancak neden bilmiyorum uygulama çalışmadı. Ekteki dosyada KOD ve benim bilgisayarın Register numarası (Control Panel > System > General > Registered to numarası) yazılıdır. Acaba windows versiyon farklılığından dolayı mı olmuyor !!! İlginize teşekkürler.
- Katılım
- 31 Ocak 2007
- Mesajlar
- 228
- Excel Vers. ve Dili
- office xp tr
®
Kodu sayfa kod bölümüne almışsınız modül içinde olmalı.
Kodu sayfa kod bölümüne almışsınız modül içinde olmalı.
Teşekkür
Sayın ileriexcel ilginize teşekkür ederim. KOD'u anladım, çalışıyor. Şu konuları da açıklarsanız memnun olurum.
1) KOD'un bulduğu Serial Number ile benim bilgisayarda beliren IP numaraları farklı çıkıyor.
2) Dosyayı kuracağım bilgisayarın IP numarasını veya KOD'un kontrol ettiği numarayı önceden nasıl bulurum.
Çok teşekkürler...
Sayın ileriexcel ilginize teşekkür ederim. KOD'u anladım, çalışıyor. Şu konuları da açıklarsanız memnun olurum.
1) KOD'un bulduğu Serial Number ile benim bilgisayarda beliren IP numaraları farklı çıkıyor.
2) Dosyayı kuracağım bilgisayarın IP numarasını veya KOD'un kontrol ettiği numarayı önceden nasıl bulurum.
Çok teşekkürler...
Son düzenleme:
Teşekkür
Sayın ileriexcel yazdığınız kodu nasıl kullanacağım konusunu çözdüm. Artık kod ile ilgili sorum kalmadı. Ancak hala bu Serial number'ın neyin numarası olduğunu ve bu numarayı Windows > Control Panel altındaki menülerde nerde bulabileceğimi merak ediyorum. İyi çalışmalar.
Sayın ileriexcel yazdığınız kodu nasıl kullanacağım konusunu çözdüm. Artık kod ile ilgili sorum kalmadı. Ancak hala bu Serial number'ın neyin numarası olduğunu ve bu numarayı Windows > Control Panel altındaki menülerde nerde bulabileceğimi merak ediyorum. İyi çalışmalar.
- Katılım
- 23 Ağustos 2005
- Mesajlar
- 4,652
- Excel Vers. ve Dili
- Excel : 2010
Bence aşağıdaki kodta aynı işi görür.
Sub Düğme1_Tıklat()
If Range("A1") = Range("A2") Then
Range("A3").Select
Exit Sub
End If
MsgBox "üzgünüm programı kullanamazsınız "
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Sub Düğme1_Tıklat()
If Range("A1") = Range("A2") Then
Range("A3").Select
Exit Sub
End If
MsgBox "üzgünüm programı kullanamazsınız "
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
haklısın. aynen iş görüyor.tşk