Excel Dosyasının Log kayıtlarını .Txt aktarma

asas44 · 14 Şubat 2017

S.a. Benim sorum bir .txt dosyasına .xlsx dosyasında yapılan işlemlerin kaydedilmesi yani excel sayfasının log kaydını tutmak istiyorum. İnternette biraz araştırdım excele kimin girdiği nezaman girdiği ve çıktıpını buldum biraz kurcaladım oluyor fakat girdiği zaman hangi satır ve sütunda ne değişiklik yaptığı, ne eklediği ve ne kadar kaldığınıda yazdırmak istiyorum onuda araştırdım fakat bu kısımda tıkandım. Konu hakkında bilgisi olan arkadaşlar yardımcı olur ise çok memnun olurum.
Örnek kod:

Sub Autpen()

Dim i As Long

i = Sheets("Sayfa1").Cells(Rows.Count, "a").End(3).Row + 1

On Error GoTo son
Open "C:\Users\Pc\Desktop\dene\Dene.txt" For Append As #1
Print #1, Environ("UserName") & "-" & CStr(Date) & "-" & CStr(Time) & CStr(ThisWorkbook.FullName) & "-HTS 36761-Açıldı"
son:
Close #1
On Error GoTo son
Open "C:\Users\Pc\Desktop\dene\Dene.txt" For Append As #1
Print #1, Environ("UserName") & "-" & CStr(Date) & "-" & CStr(Time) & CStr(ThisWorkbook.FullName) & "-HTS 36761-Kaydedildi"
Close #1

End Sub

asas44 · 15 Şubat 2017

Konu günceldir yardımcı olabilecek bilgisi olan arkadaş varsa sevinirim İyi çalışmalar.

levo26 · 15 Şubat 2017

Merhaba,
Aşağıdaki kodlları deneyiniz..
F11 TUŞUNA BASARSANIZ "YEDEK" SAYFASINI GÖREBİLİRSİNİZ.
F12 TUŞUNA BASARSANIZ "YEDEK" SAYFASINI GİZLEYEBİLİRSİNİZ.
- Sayfanın kod bölümüne

Dim Eski_Değer

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Satır = WorksheetFunction.CountA(Sheets("YEDEK").Range("A:A")) + 1
Sheets("YEDEK").Cells(Satır, 1) = Satır - 1
Sheets("YEDEK").Cells(Satır, 2) = Date
Sheets("YEDEK").Cells(Satır, 3) = Time
Sheets("YEDEK").Cells(Satır, 4) = Application.UserName
Sheets("YEDEK").Cells(Satır, 5) = ActiveSheet.Name & "!" & Target.Address(1, 1)
Sheets("YEDEK").Cells(Satır, 6) = IIf(Eski_Değer = "", "Boş Hücre", Eski_Değer)
Sheets("YEDEK").Cells(Satır, 7) = IIf(Target = "", "Değer Silindi !", Target)
Sheets("YEDEK").Cells.EntireColumn.AutoFit
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Eski_Değer = Target
End Sub

- Workbook sayfasına

Private Sub Workbook_Activate()
Sheets("YEDEK").Visible = 2
Application.OnKey "{F11}", "GÖSTER"
Application.OnKey "{F12}", "GİZLE"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "{F11}", ""
Application.OnKey "{F12}", ""
End Sub

Private Sub Workbook_Deactivate()
Application.OnKey "{F11}", ""
Application.OnKey "{F12}", ""
End Sub

Private Sub Workbook_Open()
Sheets("YEDEK").Visible = 2
Application.OnKey "{F11}", "GÖSTER"
Application.OnKey "{F12}", "GİZLE"
End Sub

- Modülüne

Sub GİZLE()
Sheets("YEDEK").Visible = 2
End Sub

Sub GÖSTER()
Sheets("YEDEK").Visible = -1
End Sub

asas44 · 15 Şubat 2017

Atladığım biryermi var acaba Alt + F11 ile kodu ekliyorum excel sayfasınıda Yedek olarak değiştiriyorum kaydedip çıkıyorum tekrar excel sayfasına girdiğimde F11 yada F12 yaptığımda farklı kaydet ve grafikler sayfaları geliyor. Muhtemelen yapamadım sanırım örnek bir dosya yükleyeyim bakarsanız çok sevinirim.

http://dosya.co/gbsoa3h1ina7/log_deneme.xlsm.html

asas44 · 16 Şubat 2017

Konu güncel yardımcı olursanız çok sevinirim .

levo26 · 17 Şubat 2017

Merhaba; örnek dosya linktedir.

http://s6.dosya.tc/server8/djf4a3/Test.xls.html
1- Dosyanın kod sayfası
2-wordbook sayfası
3- modülündeki kodalra bakınız.
f11-f12 ile gizle göster yapabilirsiniz.

asas44 · 17 Şubat 2017

levo26' Alıntı:
Merhaba; örnek dosya linktedir.

http://s6.dosya.tc/server8/djf4a3/Test.xls.html
1- Dosyanın kod sayfası
2-wordbook sayfası
3- modülündeki kodalra bakınız.
f11-f12 ile gizle göster yapabilirsiniz.

Hocam size çok teşekkür ederim bu tam kastettiğim şeydi lakin benim çalıştığım excel ler zaten oldukça yoğun veriler içeriyor. Bu yüzden logları Ağda bir metin belgesinde toplamak istiyorum bu tuttuğu logları aynı şekilde metin belgesine yazdırmak istiyorum mümkünmüdür acaba ?
Emeğiniz ve ilginiz için tekrar teşekkür ederim

asas44 · 17 Şubat 2017

Verileri direk bizim belirlediğimiz başka bir metin belgesi yada başka bir excel e yazarsa mükemmel olacak yoruyorum sizi de helal edin hakkınızı ben bayağı bir uğraştım ama yapamadım emeğinize ve ilginize tekrar teşekkür ederim.

asas44 · 19 Şubat 2017

levo26' Alıntı:
Merhaba; örnek dosya linktedir.

http://s6.dosya.tc/server8/djf4a3/Test.xls.html
1- Dosyanın kod sayfası
2-wordbook sayfası
3- modülündeki kodalra bakınız.
f11-f12 ile gizle göster yapabilirsiniz.

hocam bu işlemi başka bir metin belgesi yada başka excel dosyasına yazdırmamız mümkünmü acaba yardımınızı bekliyorum şimdiden teşekkür ederim .

asas44 · 20 Şubat 2017

levo26' Alıntı:
Merhaba; örnek dosya linktedir.

http://s6.dosya.tc/server8/djf4a3/Test.xls.html
1- Dosyanın kod sayfası
2-wordbook sayfası
3- modülündeki kodalra bakınız.
f11-f12 ile gizle göster yapabilirsiniz.

Konuya yardımcı olabilecek kimse yokmu aynı formulü metin belgesine yada başka bir excel e yazdıracak ??

halit3 · 20 Şubat 2017

Aşağıdaki kodları ThisWorkbook kod sayfasına yapıştır.

Kod:

Dim Eski_Değer

Private Sub Workbook_Open()

kayıt = ThisWorkbook.Path & "\kayit.txt" ' işlemlerin kayıt altına alındığı dosya


If CreateObject("Scripting.FileSystemObject").FileExists(kayıt) = False Then
alan1 = RightPadChar(" Kullanıcı Adı", " ", 40) & "/"
alan2 = RightPadChar("Tarih", " ", 30) & "/"
alan3 = RightPadChar("Saat", " ", 30) & "/"
alan4 = RightPadChar("Sayfa Hücre Adresi", " ", 30) & "/"
alan5 = RightPadChar("Eski Deger", " ", 30) & "/"
alan6 = RightPadChar("Yeni Deger", " ", 30) & "/"

yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6
Open kayıt For Append As #1
Print #1, yaz
'Print #1, alan1 & alan2 & alan3
Close #1
End If


alan1 = RightPadChar(Application.UserName & " Kullanıcı giris yapti", " ", 40) & "/"
alan2 = RightPadChar(Format(Now, "dd.mm.yyyy"), " ", 30) & "/"
alan3 = RightPadChar(Format(Now, "hh:nn:ss"), " ", 30) & "/"
alan4 = RightPadChar("", " ", 30) & "/"
alan5 = RightPadChar("", " ", 30) & "/"
alan6 = RightPadChar("", " ", 30) & "/"

yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6
Open kayıt For Append As #1
Print #1, yaz
'Print #1, alan1 & alan2 & alan3
Close #1


End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

kayıt = ThisWorkbook.Path & "\kayit.txt"
alan1 = RightPadChar(Application.UserName & " Kullanicisi cikis yapti", " ", 40) & "/"
alan2 = RightPadChar(Format(Now, "dd.mm.yyyy"), " ", 30) & "/"
alan3 = RightPadChar(Format(Now, "hh:nn:ss"), " ", 30) & "/"
alan4 = RightPadChar("", " ", 30) & "/"
alan5 = RightPadChar("", " ", 30) & "/"
alan6 = RightPadChar("", " ", 30) & "/"

yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6
Open kayıt For Append As #1
Print #1, yaz
Close #1

ActiveWorkbook.Save
ThisWorkbook.Close savechanges:=False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

kayıt = ThisWorkbook.Path & "\kayit.txt"

alan1 = RightPadChar(Application.UserName & " Kullanicisi kayıt yaptı", " ", 40) & "/"
alan2 = RightPadChar(Format(Now, "dd.mm.yyyy"), " ", 30) & "/"
alan3 = RightPadChar(Format(Now, "hh:nn:ss"), " ", 30) & "/"
alan4 = RightPadChar("", " ", 30) & "/"
alan5 = RightPadChar("", " ", 30) & "/"
alan6 = RightPadChar("", " ", 30) & "/"

yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6

Open kayıt For Append As #1
Print #1, yaz
Close #1

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

On Error Resume Next
If kontrol = False Then

If Target.Count > 1 Then Exit Sub

alan1 = Application.UserName
alan2 = Format(Now, "dd.mm.yyyy")
alan3 = Format(Now, "hh:nn:ss")
alan4 = ActiveSheet.Name & "!" & Target.Address(1, 1)
alan5 = IIf(Eski_Değer = "", "Boş Hücre", Eski_Değer)
If Target = "" Then
alan6 = "Değer Silindi !"
ElseIf Target.HasFormula = True Then
alan6 = "'" & Target.Formula
Else
alan6 = Target
End If

alan1 = RightPadChar(alan1, " ", 40) & "/"
alan2 = RightPadChar(alan2, " ", 30) & "/"
alan3 = RightPadChar(alan3, " ", 30) & "/"
alan4 = RightPadChar(alan4, " ", 30) & "/"
alan5 = RightPadChar(alan5, " ", 30) & "/"
alan6 = RightPadChar(alan6, " ", 30) & "/"
yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6
kayıt = ThisWorkbook.Path & "\kayit.txt"

Open kayıt For Append As #1
Print #1, yaz
Close #1

End If
kontrol = False

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Target.Count > 1 Then Exit Sub
If Target.HasFormula = True Then
Eski_Değer = "'" & Target.Formula
Else
Eski_Değer = Target
End If
kontrol = False
End Sub


Function RightPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = Astr + String(stLen - AStrL, PadChar)
Else
Astr = Mid$(Astr, 1, stLen)
End If
RightPadChar = Astr
End Function
Function LeftPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = String(stLen - AStrL, PadChar) + Astr
Else
Astr = Mid$(Astr, 1, stLen)
End If
LeftPadChar = Astr
End Function

halit3 · 20 Şubat 2017

Kayıtlı verileri txt uzantılı dosyadan excelle almak için kod;

Kod:

Sub CommandButton1_Click()

parametre = InputBox("Kayıtları okuyabilmeniz için giriş şifresini giriniz şifre ", "uyarı!")
If parametre <> "1234" Then
MsgBox "Yanlış şifre girdiniz"
Exit Sub
End If

'On Error Resume Next
kayıt = ThisWorkbook.Path & "\kayit.txt"
Open kayıt For Append As #1
Close #1

Open kayıt For Input As #1

Do While Not EOF(1)
Line Input #1, deg1

sat = sat + 1
deg2 = Split(deg1, "/")
k = 0
For i = 0 To UBound(deg2)
k = k + 1

If sat > 1 Then
If k = 2 Then
Cells(sat, k).Value = Format(Trim(deg2(i)), "dd.mm.yyyy")

ElseIf k = 3 Then
Cells(sat, k).Value = Format(Trim(deg2(i)), "hh:nn:ss")
Else
Cells(sat, k).Value = Trim(deg2(i))
End If
Else
Cells(sat, k).Value = Trim(deg2(i))
End If
Next i
Loop
Close #1


End Sub

asas44 · 20 Şubat 2017

Halit bey elinize yüreğinize sağlık fevkalade olmuş Allah razı olsun eminim birçok kişiyede yarayacaktır. Son küçük bir detay eksikliği var oda satır silinip yada eklendiğinde de durumu yazsa harika olurdu size zahmet olmaz ise satır sütun durumunuda yazarsa çok süper olur. Tekrar emeğinize sağlık.

halit3 · 1 Mart 2017

asas44' Alıntı:
Halit bey elinize yüreğinize sağlık fevkalade olmuş Allah razı olsun eminim birçok kişiyede yarayacaktır. Son küçük bir detay eksikliği var oda satır silinip yada eklendiğinde de durumu yazsa harika olurdu size zahmet olmaz ise satır sütun durumunuda yazarsa çok süper olur. Tekrar emeğinize sağlık.

Bu kod aktif sayfanın birinci satır son sütununa ve birinci sütun son satıra nokta (.) işareti koymakta satır ve sütun silindiğinde nokta işaretleri kaymış olacağından log kayıtı tutacaktır bunun yanında satır ekleme işlemi yapmıyacaktır.

kod:

Kod:

Dim Eski_Değer

Private Sub Workbook_Activate()

If Worksheets(ActiveSheet.Name).Cells(Rows.Count, 1).Value <> "." Then
Worksheets(ActiveSheet.Name).Cells(Rows.Count, 1) = "."
End If
If Worksheets(ActiveSheet.Name).Cells(1, Columns.Count).Value <> "." Then
Worksheets(ActiveSheet.Name).Cells(1, Columns.Count) = "."
End If

End Sub

Private Sub Workbook_Open()

kayıt = ThisWorkbook.Path & "\kayit.txt" ' işlemlerin kayıt altına alındığı dosya

If CreateObject("Scripting.FileSystemObject").FileExists(kayıt) = False Then
alan1 = RightPadChar(" Kullanıcı Adı", " ", 40) & "/"
alan2 = RightPadChar("Tarih", " ", 30) & "/"
alan3 = RightPadChar("Saat", " ", 30) & "/"
alan4 = RightPadChar("Sayfa Hücre Adresi", " ", 30) & "/"
alan5 = RightPadChar("Eski Deger", " ", 30) & "/"
alan6 = RightPadChar("Yeni Deger", " ", 30) & "/"

yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6
Open kayıt For Append As #1
Print #1, yaz
Close #1
End If


alan1 = RightPadChar(Application.UserName & " Kullanıcı giris yapti", " ", 40) & "/"
alan2 = RightPadChar(Format(Now, "dd.mm.yyyy"), " ", 30) & "/"
alan3 = RightPadChar(Format(Now, "hh:nn:ss"), " ", 30) & "/"
alan4 = RightPadChar("", " ", 30) & "/"
alan5 = RightPadChar("", " ", 30) & "/"
alan6 = RightPadChar("", " ", 30) & "/"

yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6
Open kayıt For Append As #1
Print #1, yaz
Close #1

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

kayıt = ThisWorkbook.Path & "\kayit.txt"
alan1 = RightPadChar(Application.UserName & " Kullanicisi cikis yapti", " ", 40) & "/"
alan2 = RightPadChar(Format(Now, "dd.mm.yyyy"), " ", 30) & "/"
alan3 = RightPadChar(Format(Now, "hh:nn:ss"), " ", 30) & "/"
alan4 = RightPadChar("", " ", 30) & "/"
alan5 = RightPadChar("", " ", 30) & "/"
alan6 = RightPadChar("", " ", 30) & "/"

yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6
Open kayıt For Append As #1
Print #1, yaz
Close #1

ActiveWorkbook.Save
ThisWorkbook.Close savechanges:=False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

kayıt = ThisWorkbook.Path & "\kayit.txt"

alan1 = RightPadChar(Application.UserName & " Kullanicisi kayıt yaptı", " ", 40) & "/"
alan2 = RightPadChar(Format(Now, "dd.mm.yyyy"), " ", 30) & "/"
alan3 = RightPadChar(Format(Now, "hh:nn:ss"), " ", 30) & "/"
alan4 = RightPadChar("", " ", 30) & "/"
alan5 = RightPadChar("", " ", 30) & "/"
alan6 = RightPadChar("", " ", 30) & "/"

yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6

Open kayıt For Append As #1
Print #1, yaz
Close #1

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Worksheets(ActiveSheet.Name).Cells(Rows.Count, 1).Value <> "." Then
Worksheets(ActiveSheet.Name).Cells(Rows.Count, 1) = "."
End If
If Worksheets(ActiveSheet.Name).Cells(1, Columns.Count).Value <> "." Then
Worksheets(ActiveSheet.Name).Cells(1, Columns.Count) = "."
End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
sutun = Target.Column
satir = Target.Row

On Error Resume Next
If kontrol = False Then

alan1 = Application.UserName
alan2 = Format(Now, "dd.mm.yyyy")
alan3 = Format(Now, "hh:nn:ss")
alan4 = ActiveSheet.Name & "!" & Target.Address(1, 1)
alan5 = IIf(Eski_Değer = "", "Boş Hücre", Eski_Değer)
If Target = "" Then
alan6 = "Değer Silindi !"
ElseIf Target.HasFormula = True Then
alan6 = "'" & Target.Formula
Else
alan6 = Target
End If

alan1 = RightPadChar(alan1, " ", 40) & "/"
alan2 = RightPadChar(alan2, " ", 30) & "/"
alan3 = RightPadChar(alan3, " ", 30) & "/"
alan4 = RightPadChar(alan4, " ", 30) & "/"
alan5 = RightPadChar(alan5, " ", 30) & "/"
alan6 = RightPadChar(alan6, " ", 30) & "/"
yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6
kayıt = ThisWorkbook.Path & "\kayit.txt"

Open kayıt For Append As #1
Print #1, yaz
Close #1

End If

If Worksheets(ActiveSheet.Name).Cells(Rows.Count, 1).Value <> "." Then
'MsgBox Worksheets(ActiveSheet.Name).Cells(Rows.Count - 1, 1).Value
Worksheets(ActiveSheet.Name).Cells(Rows.Count, 1).Value = "."
Worksheets(ActiveSheet.Name).Cells(Rows.Count - 1, 1).Value = ""

alan1 = Application.UserName
alan2 = Format(Now, "dd.mm.yyyy")

alan3 = Format(Now, "hh:nn:ss")
alan4 = ActiveSheet.Name & "!" & Target.Address(1, 1)
alan5 = IIf(Eski_Değer = "", "", Eski_Değer)
alan6 = satir & " Satır silindi"

alan1 = RightPadChar(alan1, " ", 40) & "/"
alan2 = RightPadChar(alan2, " ", 30) & "/"
alan3 = RightPadChar(alan3, " ", 30) & "/"
alan4 = RightPadChar(alan4, " ", 30) & "/"
alan5 = RightPadChar(alan5, " ", 30) & "/"
alan6 = RightPadChar(alan6, " ", 30) & "/"
yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6
kayıt = ThisWorkbook.Path & "\kayit.txt"

Open kayıt For Append As #1
Print #1, yaz
Close #1

End If
If Worksheets(ActiveSheet.Name).Cells(1, Columns.Count).Value <> "." Then
'MsgBox Worksheets(ActiveSheet.Name).Cells(1, Columns.Count - 1).Value
Worksheets(ActiveSheet.Name).Cells(1, Columns.Count).Value = "."
Worksheets(ActiveSheet.Name).Cells(1, Columns.Count - 1).Value = ""

alan1 = Application.UserName
alan2 = Format(Now, "dd.mm.yyyy")
alan3 = Format(Now, "hh:nn:ss")
alan4 = ActiveSheet.Name & "!" & Target.Address(1, 1)
alan5 = IIf(Eski_Değer = "", "", Eski_Değer)
alan6 = sutun & " Sutun silindi"

alan1 = RightPadChar(alan1, " ", 40) & "/"
alan2 = RightPadChar(alan2, " ", 30) & "/"
alan3 = RightPadChar(alan3, " ", 30) & "/"
alan4 = RightPadChar(alan4, " ", 30) & "/"
alan5 = RightPadChar(alan5, " ", 30) & "/"
alan6 = RightPadChar(alan6, " ", 30) & "/"
yaz = alan1 & alan2 & alan3 & alan4 & alan5 & alan6
kayıt = ThisWorkbook.Path & "\kayit.txt"

Open kayıt For Append As #1
Print #1, yaz
Close #1

End If


kontrol = False

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next

If Target.Count > 1 Then Exit Sub
If Target.HasFormula = True Then
Eski_Değer = "'" & Target.Formula
Else
Eski_Değer = Target
End If
kontrol = False
End Sub


Function RightPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = Astr + String(stLen - AStrL, PadChar)
Else
Astr = Mid$(Astr, 1, stLen)
End If
RightPadChar = Astr
End Function

asas44 · 2 Mart 2017

Halit bey elinize kolunuza sağlık.

halit3 · 3 Mart 2017

asas44' Alıntı:
Halit bey elinize kolunuza sağlık.

Teşekkürler iyi çalışmalar

Excel Dosyasının Log kayıtlarını .Txt aktarma

asas44

asas44

levo26

asas44

asas44

levo26

asas44

asas44

asas44

asas44

halit3

Uzman

halit3

Uzman

asas44

halit3

Uzman

asas44

halit3

Uzman