Yapılan Excel Tek Bilgisayarda Çalışsın

[aykokbay]

Excel de yapılan bir çalışmayı sadece yapıldığı bilgisayarda kullanmak istiyorum. Kopyalanmasın, taşınmasın bu şekilde yapabilir miyiz? Yardımcı olursanız sevinirim.

 

[askm]

Private Function HD_SNo(DrvIdx As Byte) As String
Dim strCls As String, strKey As String
Dim WMI As Object
Set WMI = GetObject("winmgmts:")
strCls = "Win32_PhysicalMedia"
strKey = strCls & ".Tag=""\\\\.\\PHYSICALDRIVE" & DrvIdx & """"
HD_SNo = Trim(WMI.InstancesOf(strCls)(strKey).SerialNumber)
End Function


Sub HDSerial()
MsgBox HD_SNo(0)
End Sub

Bu kodlar ile HDD Seri no öğrenip, Seri no farklı ile dosyayı kaydet sil yapabilirsiniz. Yalnız siz de farklı bilgisayarda makro güvenliğini düşürmeden açamazsınız.

 

[aykokbay]

Verdiğiniz bilgiler için sağolun, yalnız yazdım ama olmadı yaptığım örneği göndersem yardımcı olur musunuz?

 

[aykokbay]

yada çalışan bir örnek göndere bilirseniz çok sevinirim. Şimdiden sağolun

 

[askm]

Hem kodları yazıyorum. Hem de örnek gönderiyorum. (Otomatik olarak dosya kendini siler.)

Private Function HD_SNo(DrvIdx As Byte) As String
Dim strCls As String, strKey As String
Dim WMI As Object
Set WMI = GetObject("winmgmts:")
strCls = "Win32_PhysicalMedia"
strKey = strCls & ".Tag=""\\\\.\\PHYSICALDRIVE" & DrvIdx & """"
HD_SNo = Trim(WMI.InstancesOf(strCls)(strKey).SerialNumber)
End Function


Private Sub Workbook_Open()
Set S1 = Sheets("Sayfa1")

S1.[b1] = HD_SNo(0)

If S1.Cells(1, 1).Value = S1.Cells(1, 2).Value Then
S1.Cells(1, 1).Value = S1.Cells(1, 2).Value
S1.Cells(1, 2).ClearContents
Else
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close savechanges:=False
End With
End If
End Sub



Module

Private Function HD_SNo(DrvIdx As Byte) As String
Dim strCls As String, strKey As String
Dim WMI As Object
Set WMI = GetObject("winmgmts:")
strCls = "Win32_PhysicalMedia"
strKey = strCls & ".Tag=""\\\\.\\PHYSICALDRIVE" & DrvIdx & """"
HD_SNo = Trim(WMI.InstancesOf(strCls)(strKey).SerialNumber)
End Function


Sub HDSerial()
Set S1 = Sheets("Sayfa1")
S1.[a1] = HD_SNo(0)
End Sub

 

[Korhan Ayhan]

Makrolar etkinleştirilmezse dosya kullanıma açık olur...

 

[aykokbay]

Çok sağolun. Hard diskin seri numarasını yazmamız gerekir mi? Kendi mi buluyor? Module nereye yazacağımı bulamadım içeriği etkinleştirdim mi siliniyor.

 

[Erdem Akdemir]

Bu durumlarda en iyi yöntem açılışa şifre koymaktır.
Korhan bey'in dediği gibi makrolar devre dışı bırakılırsa koruma önlemleri çalışmaz

 

[kemalist]

Bu durumlarda en iyi yöntem açılışa şifre koymaktır.
Korhan bey'in dediği gibi makrolar devre dışı bırakılırsa koruma önlemleri çalışmaz

şifre kırıcı programlarla şifreler kırılabiliyor hırsıza kilit olmuyor