vb kodlarını başka sayfaya yazdırılması.

[talebeyim]

Aşağıdaki kodları Sheet1'in B : 65515 hücresine yazdırmak istiyorum ama kodlar kendini ilk boş buldugu yere yazıyor, ayrıca sayfa korumasını actıgımda kodlar işlemini yapmıyor bu konuda yardımcı olabilirmisiniz ? ve ben kesinlikle sayfa koruması yapmalıyım.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
kayit = FormatDateTime(Now, vbGeneralDate)
End Sub

Private Sub Workbook_Open()
On Error Resume Next

kayit = "Kaydedilmedi!"
Dim mesaj As String
acilis = FormatDateTime(Now, vbGeneralDate)
muhammed = Cells.SpecialCells(xlCellTypeLastCell).Column
mesaj = mesaj & "Bilgisayar hakkında:" & vbCrLf
mesaj = mesaj & "--------------------------------" & vbCrLf
mesaj = mesaj & "Ad:" & Cells(65510, muhammed) & vbCrLf
mesaj = mesaj & "Tip:" & Cells(65511, muhammed) & vbCrLf
mesaj = mesaj & "Üretici:" & Cells(65512, muhammed) & vbCrLf
mesaj = mesaj & "Model:" & Cells(65513, muhammed) & vbCrLf
mesaj = mesaj & "Ram:" & Cells(65514, muhammed) & vbCrLf
mesaj = mesaj & "Domain:" & Cells(65515, muhammed) & vbCrLf
mesaj = mesaj & "Kullanıcı:" & Cells(65516, muhammed) & vbCrLf
mesaj = mesaj & "Excel kullanıcı adı:" & Cells(65517, muhammed) & vbCrLf
mesaj = mesaj & "Dosyayı son kaydeden:" & Cells(65518, muhammed) & vbCrLf
mesaj = mesaj & "IP Adresi:" & Cells(65519, muhammed) & vbCrLf
mesaj = mesaj & "Dosya açılış zamanı:" & Cells(65520, muhammed) & vbCrLf
mesaj = mesaj & "Dosya kapanış zamanı:" & Cells(65521, muhammed) & vbCrLf
mesaj = mesaj & "Dosya son açılıştaki kayıt zamanı:" & Cells(65522, muhammed) & vbCrLf
mesaj = mesaj & "Dosya genel son kayıt zamanı:" & ActiveWorkbook.BuiltinDocumentProperties("Last Save Time") & vbCrLf
mesaj = mesaj & "Dosya kullanım süresi:" & FormatDateTime(Cells(65523, muhammed), vbLongTime) & vbCrLf

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
kapanis = FormatDateTime(Now, vbGeneralDate)
Dim MyMsg As String, oSystem As Object, Item As Object
muhammed = Cells.SpecialCells(xlCellTypeLastCell).Column + 1
Set oSystem = GetObject("winmgmts:").instancesOf("Win32_ComputerSystem")
For Each Item In oSystem
Cells(65510, muhammed) = Item.Name
Cells(65511, muhammed) = Item.SystemType
Cells(65512, muhammed) = Item.Manufacturer
Cells(65513, muhammed) = Item.Model
Cells(65514, muhammed) = Item.TotalPhysicalMemory \ 1024000 & " Mb"
Cells(65515, muhammed) = Item.Domain
Cells(65516, muhammed) = Item.UserName
Cells(65517, muhammed) = Application.UserName
Cells(65518, muhammed) = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
Next
Set oSystem = Nothing

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set IPConfigSet = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
For Each IPConfig In IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
adres = IPConfig.IPAddress(i)
Next
End If
Next
Cells(65519, muhammed) = adres
Cells(65520, muhammed) = acilis
Cells(65521, muhammed) = kapanis
Cells(65522, muhammed) = kayit
Cells(65523, muhammed) = FormatDateTime(CDate(kapanis) - (CDate(acilis)), vbLongTime)
ThisWorkbook.Save
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
kayit = FormatDateTime(Now, vbGeneralDate)
End Sub
Private Sub Workbook_Open()
On Error Resume Next
kayit = "Kaydedilmedi!"
Dim mesaj As String
acilis = FormatDateTime(Now, vbGeneralDate)
muhammed = 2
mesaj = mesaj & "Bilgisayar hakkında:" & vbCrLf
mesaj = mesaj & "--------------------------------" & vbCrLf
mesaj = mesaj & "Ad:" & Cells(65510, muhammed) & vbCrLf
mesaj = mesaj & "Tip:" & Cells(65511, muhammed) & vbCrLf
mesaj = mesaj & "Üretici:" & Cells(65512, muhammed) & vbCrLf
mesaj = mesaj & "Model:" & Cells(65513, muhammed) & vbCrLf
mesaj = mesaj & "Ram:" & Cells(65514, muhammed) & vbCrLf
mesaj = mesaj & "Domain:" & Cells(65515, muhammed) & vbCrLf
mesaj = mesaj & "Kullanıcı:" & Cells(65516, muhammed) & vbCrLf
mesaj = mesaj & "Excel kullanıcı adı:" & Cells(65517, muhammed) & vbCrLf
mesaj = mesaj & "Dosyayı son kaydeden:" & Cells(65518, muhammed) & vbCrLf
mesaj = mesaj & "IP Adresi:" & Cells(65519, muhammed) & vbCrLf
mesaj = mesaj & "Dosya açılış zamanı:" & Cells(65520, muhammed) & vbCrLf
mesaj = mesaj & "Dosya kapanış zamanı:" & Cells(65521, muhammed) & vbCrLf
mesaj = mesaj & "Dosya son açılıştaki kayıt zamanı:" & Cells(65522, muhammed) & vbCrLf
mesaj = mesaj & "Dosya genel son kayıt zamanı:" & ActiveWorkbook.BuiltinDocumentProperties("Last Save Time") & vbCrLf
mesaj = mesaj & "Dosya kullanım süresi:" & FormatDateTime(Cells(65523, muhammed), vbLongTime) & vbCrLf
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
ActiveSheet.Unprotect "şifre"
kapanis = FormatDateTime(Now, vbGeneralDate)
Dim MyMsg As String, oSystem As Object, Item As Object
muhammed = 2
Set oSystem = GetObject("winmgmts:").instancesOf("Win32_Computer System")
For Each Item In oSystem
Cells(65510, muhammed) = Item.Name
Cells(65511, muhammed) = Item.SystemType
Cells(65512, muhammed) = Item.Manufacturer
Cells(65513, muhammed) = Item.Model
Cells(65514, muhammed) = Item.TotalPhysicalMemory \ 1024000 & " Mb"
Cells(65515, muhammed) = Item.Domain
Cells(65516, muhammed) = Item.UserName
Cells(65517, muhammed) = Application.UserName
Cells(65518, muhammed) = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
Next
Set oSystem = Nothing
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set IPConfigSet = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
For Each IPConfig In IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
adres = IPConfig.IPAddress(i)
Next
End If
Next
Cells(65519, muhammed) = adres
Cells(65520, muhammed) = acilis
Cells(65521, muhammed) = kapanis
Cells(65522, muhammed) = kayit
Cells(65523, muhammed) = FormatDateTime(CDate(kapanis) - (CDate(acilis)), vbLongTime)
ActiveSheet.Protect "şifre"
ThisWorkbook.Save
End Sub

 

[talebeyim]

Levent bey malesef bu yazdıgınız olmadı yani çok güzel koruma bilene varken kayıt yapıyor ama hem O info kısmı kısalmış ve hemde normal daha fazla detay vardı hemde yan yana son degisiklikleri gösteren log vardı.
ayrıca bu veriler B sütunu ve 65515 satırından itibaren başlaması gerekiyor ve dosya her kullanımda yanına log atması gerekiyor.
yani su örnekte biraz açıklamaya calıstım

 

[talebeyim]

Levent bey tam olarak anlatabildimmi ?

 

[talebeyim]

....güncel....