İşlem Yapılmadığında Belirlenen Süre Sonra Kapanan Excel

Excel VBA kodlamaları ile yapılmış örnek dosyaları burdan izleyebilir ve paylaşabilirsiniz.

Cevap: Cevap: Cevap: İşlem Yapılmadığında Belirlenen Süre So

İleti#41)  Miraç CAN » 07 Mar 2020 17:34

Miraç CAN yazdı:
Kod: Tümünü seç
Option Explicit
Private EskiDeger As Variant
Private Durum As Variant
Private Const Gecikme As Date = 10 / 86400
Private Const Onerilen_Zaman As Date = 5 * 60 / 86400
Private Süre As Variant
Private Temps As Date
Private Zaman As Date
Private Sub TimeSlot(Optional Reset As Boolean)
    On Error Resume Next
    Application.OnTime Temps, Procedure:="BuÇalışmaKitabı.TimeSlot", Schedule:=False
    If IsMissing(Reset) Or (Reset = False) Then
        If (Zaman <= Gecikme) Then
            BuÇalışmaKitabı.Close ([False])

            End If
        Zaman = Zaman - Gecikme
    Else
        Zaman = Süre
    End If
    Temps = Now + Gecikme
    Application.OnTime Temps, Procedure:="BuÇalışmaKitabı.TimeSlot"
    ActiveWindow.Caption = Split(ActiveWindow.Caption, " [")(0) & " [" & Zaman & "]"
End Sub
Private Sub Workbook_Open()
    Do
    Loop Until (Süre = False) Or IsDate(Süre)
    Süre = IIf(IsDate(Süre), Süre, Onerilen_Zaman)
    TimeSlot True
Sheets("Log").Range("a65536").End(3)(2, 2).Value = Format(Now(), "hh:mm:ss")
Sheets("Log").Range("a65536").End(3)(2, 3).Value = ActiveSheet.Name
Sheets("Log").Range("a65536").End(3)(2, 7).Value = "giriş yaptı."
Sheets("Log").Range("a65536").End(3)(2, 8).Value = Environ("username")
Sheets("Log").Range("a65536").End(3)(2, 1).Value = Format(Now(), "dd.mm.yyyy dddd")
        Sheets("Log").Range("a65536").End(3).Resize(1, 8).Interior.ColorIndex = 1
        Sheets("Log").Range("a65536").End(3).Resize(1, 8).Font.ColorIndex = 4
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
        Application.OnTime Temps, Procedure:="BuÇalışmaKitabı.TimeSlot", Schedule:=False
Sheets("Log").Range("a65536").End(3)(2, 2).Value = Format(Now(), "hh:mm:ss")
Sheets("Log").Range("a65536").End(3)(2, 3).Value = ActiveSheet.Name
Sheets("Log").Range("a65536").End(3)(2, 7).Value = "çıkış yaptı."
Sheets("Log").Range("a65536").End(3)(2, 8).Value = Environ("username")
Sheets("Log").Range("a65536").End(3)(2, 1).Value = Format(Now(), "dd.mm.yyyy dddd")
        Sheets("Log").Range("a65536").End(3).Resize(1, 8).Interior.ColorIndex = 1
        Sheets("Log").Range("a65536").End(3).Resize(1, 8).Font.ColorIndex = 3
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Application.Caption = ActiveSheet.Name
    If Sheets("Log").Log_CheckBox_1.Value = True Then
    If Sh.Name <> "Log" Then
        Sheets("Log").Range("a65536").End(3)(2, 2).Value = Format(Now(), "hh:mm:ss")
        Sheets("Log").Range("a65536").End(3)(2, 3).Value = Sh.Name
        Sheets("Log").Range("a65536").End(3)(2, 7).Value = "'sayfasını seçti."
        Sheets("Log").Range("a65536").End(3)(2, 8).Value = Environ("username")
        Sheets("Log").Range("a65536").End(3)(2, 1).Value = Format(Now(), "dd.mm.yyyy dddd")
    End If
    Else
    End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If IsEmpty(Target.Value) Then Durum = "sildi"
If Selection.Count = 1 Then
If Sh.Name <> "Log" Then
Sheets("Log").Range("a65536").End(3)(2, 2).Value = Format(Now(), "hh:mm:ss")
Sheets("Log").Range("a65536").End(3)(2, 3).Value = Sh.Name
Sheets("Log").Hyperlinks.Add Anchor:=Sheets("Log").Range("a65536").End(3)(2, 4), Address:="", SubAddress:="'" & Sh.Name & "'!" & Target.Address(0, 0), TextToDisplay:=Target.Address(0, 0)
Sheets("Log").Range("a65536").End(3)(2, 5).Value = EskiDeger
Sheets("Log").Range("a65536").End(3)(2, 6).Value = Target.Offset(0, 0).Value
Sheets("Log").Range("a65536").End(3)(2, 7).Value = Durum
Sheets("Log").Range("a65536").End(3)(2, 8).Value = Environ("username")
Sheets("Log").Range("a65536").End(3)(2, 1).Value = Format(Now(), "dd.mm.yyyy dddd")
        Sheets("Log").Range("a65536").End(3)(1, 1).Borders(1).LineStyle = 3
        Sheets("Log").Range("a65536").End(3).Resize(1, 8).Borders(3).LineStyle = 3
        Sheets("Log").Range("a65536").End(3).Resize(1, 8).Borders(4).LineStyle = 3
        Sheets("Log").Range("a65536").End(3).Resize(1, 8).Interior.ColorIndex = 19
        Sheets("Log").Range("a65536").End(3)(1, 8).Borders(2).LineStyle = 3
Else
End If
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    TimeSlot True
    If Sheets("Log").Log_CheckBox_2.Value = True Then
        If Sh.Name <> "Log" Then
            Sheets("Log").Range("a65536").End(3)(2, 2).Value = Format(Now(), "hh:mm:ss")
            Sheets("Log").Range("a65536").End(3)(2, 3).Value = Sh.Name
            Sheets("Log").Hyperlinks.Add Anchor:=Sheets("Log").Range("a65536").End(3)(2, 4), Address:="", SubAddress:="'" & Sh.Name & "'!" & Target.Address(0, 0), TextToDisplay:=Target.Address(0, 0)
            Sheets("Log").Range("a65536").End(3)(2, 7).Value = "'hücresini seçti."
            Sheets("Log").Range("a65536").End(3)(2, 8).Value = Environ("username")
            Sheets("Log").Range("a65536").End(3)(2, 1).Value = Format(Now(), "dd.mm.yyyy dddd")
        End If
        Else
    End If
            If Target.Count > 1 Then Exit Sub
            If Target = "" Then
                EskiDeger = "boş"
            Else: EskiDeger = Target.Value
            End If
     
            If EskiDeger = "boş" Then
                Durum = "'yazdı."
            Else: Durum = "'olarak değiştirdi."
            End If
End Sub

Söylemeyi unuttum. Log kaydı dosyası ThisWorkbook sayfa kodları ile değiştirin.
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 1009
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya & Adana

Cevap: Cevap: Cevap: Cevap: İşlem Yapılmadığında Belirlenen

İleti#42)  mikrenos » 07 Mar 2020 20:39

Miraç CAN yazdı:
Miraç CAN yazdı:
Söylemeyi unuttum. Log kaydı dosyası ThisWorkbook sayfa kodları ile değiştirin.


Teşekkür ederim Miraç Bey. Şuan gözlemlerime göre hem log alıyor hemde sayaç başlangıçta geliyor ve sıkıntısız kapatıyor.

Miraç Bey log kaydı alan kodlar birden çok hücre seçip silindiğinde kayıt almıyor. Örnek olarak A1:A10 siliniyor ancak kayıt düşmüyor. Bu konuda yardımcı olabilir misiniz?
Kullanıcı avatarı
mikrenos
 
Kayıt: 31 May 2019 09:09
Meslek: Coğrafya CBS
Yaş: 32
İleti: 9
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Samsun

Cevap: Cevap: Cevap: Cevap: Cevap: İşlem Yapılmadığında Beli

İleti#43)  Miraç CAN » 08 Mar 2020 15:14

mikrenos yazdı:
Miraç CAN yazdı:
Miraç CAN yazdı:
Söylemeyi unuttum. Log kaydı dosyası ThisWorkbook sayfa kodları ile değiştirin.


Teşekkür ederim Miraç Bey. Şuan gözlemlerime göre hem log alıyor hemde sayaç başlangıçta geliyor ve sıkıntısız kapatıyor.

Miraç Bey log kaydı alan kodlar birden çok hücre seçip silindiğinde kayıt almıyor. Örnek olarak A1:A10 siliniyor ancak kayıt düşmüyor. Bu konuda yardımcı olabilir misiniz?

Declaraitons bölümüne: Private Stp As Boolean, Chng() As Boolean
(Kod sayfasının en üst bölümü, Option Explicit altına)
Aşağıda ki kodları da eksileri ile değiştirin;
Kod: Tümünü seç
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Stp Or Sh.Name Like "Log" Then Exit Sub
Dim R As Range, s%, Trgt As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("Log").Range("a" & Rows.Count)
For s = LBound(Split(Target.Address(0, 0), ",")) To UBound(Split(Target.Address(0, 0), ","))
    Set Trgt = Range(Split(Target.Address(0, 0), ",")(s))
    If Target.Count > 1 And Chng(s) Then
        .End(3)(2, 2).Value = Format(Now(), "hh:mm:ss")
        .End(3)(2, 3).Value = Sh.Name
        Sheets("Log").Hyperlinks.Add Anchor:=.End(3)(2, 4), Address:="", _
                SubAddress:="'" & Sh.Name & "'!" & Trgt.Address(0, 0), _
                TextToDisplay:=Trgt.Address(0, 0)
        .End(3)(2, 5).Value = EskiDeger(Trgt.Row, Trgt.Column)
        .End(3)(2, 6).Value = Cells(Trgt.Row, Trgt.Column).Value
        .End(3)(2, 7).Value = IIf(IsEmpty(Cells(Trgt.Row, Trgt.Column).Value), "sildi", Durum(Trgt.Row, Trgt.Column))
        .End(3)(2, 8).Value = Environ("username")
        .End(3)(2, 1).Value = Format(Now(), "dd.mm.yyyy dddd")
                .End(3)(1, 1).Borders(1).LineStyle = 3
                .End(3).Resize(1, 8).Borders(3).LineStyle = 3
                .End(3).Resize(1, 8).Borders(4).LineStyle = 3
                .End(3).Resize(1, 8).Interior.ColorIndex = 19
                .End(3)(1, 8).Borders(2).LineStyle = 3
        For Each R In Trgt
            If IsEmpty(R.Value) Then
                EskiDeger(R.Row, R.Column) = "boş"
                Durum(R.Row, R.Column) = "'yazdı."
            Else
                EskiDeger(R.Row, R.Column) = R.Value
                Durum(R.Row, R.Column) = "'olarak değiştirdi."
            End If
        Next R
    Else
        For Each R In Trgt
            .End(3)(2, 2).Value = Format(Now(), "hh:mm:ss")
            .End(3)(2, 3).Value = Sh.Name
            Sheets("Log").Hyperlinks.Add Anchor:=.End(3)(2, 4), Address:="", _
                    SubAddress:="'" & Sh.Name & "'!" & R.Address(0, 0), _
                    TextToDisplay:=R.Address(0, 0)
            .End(3)(2, 5).Value = EskiDeger(R.Row, R.Column)
            .End(3)(2, 6).Value = R.Value
            .End(3)(2, 7).Value = IIf(IsEmpty(R.Value), "sildi", Durum(R.Row, R.Column))
            .End(3)(2, 8).Value = Environ("username")
            .End(3)(2, 1).Value = Format(Now(), "dd.mm.yyyy dddd")
                    .End(3)(1, 1).Borders(1).LineStyle = 3
                    .End(3).Resize(1, 8).Borders(3).LineStyle = 3
                    .End(3).Resize(1, 8).Borders(4).LineStyle = 3
                    .End(3).Resize(1, 8).Interior.ColorIndex = 19
                    .End(3)(1, 8).Borders(2).LineStyle = 3
            If IsEmpty(R.Value) Then
                EskiDeger(R.Row, R.Column) = "boş"
                Durum(R.Row, R.Column) = "'yazdı."
            Else
                EskiDeger(R.Row, R.Column) = R.Value
                Durum(R.Row, R.Column) = "'olarak değiştirdi."
            End If
        Next R
        If Application.CountIf(Trgt, "=" & Cells(Trgt.Row, Trgt.Column).Value) = Trgt.Rows.Count * Trgt.Columns.Count Then _
        Chng(s) = True Else Chng(s) = False
    End If
Next s
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Kod: Tümünü seç
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
TimeSlot True
If Sh.Name Like "Log" Then Exit Sub
Dim R As Range, s%, Trgt As Range
With Sheets("Log").Range("a" & Rows.Count)
    If Sheets("Log").Log_CheckBox_2.Value = True Then
        Stp = True
        .End(3)(2, 1).Value = Format(Now(), "dd.mm.yyyy dddd")
        .End(3)(1, 2).Value = Format(Now(), "hh:mm:ss")
        .End(3)(1, 3).Value = Sh.Name
        Sheets("Log").Hyperlinks.Add Anchor:=.End(3)(1, 4), Address:="", _
        SubAddress:="'" & Sh.Name & "'!" & Split(Target.Address(0, 0), ",")(UBound(Split(Target.Address(0, 0), ","))), _
        TextToDisplay:=Target.Address(0, 0)
        .End(3)(1, 7).Value = IIf((Target.Rows.Count + Target.Columns.Count) > 2, "'hücrelerini seçti.", "'hücresini seçti.")
        .End(3)(1, 8).Value = Environ("username")
        Stp = False
    End If
End With
    ReDim EskiDeger(1 To 2, 0 To UBound(Split(Target.Address(0, 0), ",")))
    ReDim Durum(1 To 2, 0 To UBound(Split(Target.Address(0, 0), ",")))
    ReDim Chng(UBound(Split(Target.Address(0, 0), ",")))
    For s = LBound(Split(Target.Address(0, 0), ",")) To UBound(Split(Target.Address(0, 0), ","))
        Set Trgt = Range(Split(Target.Address(0, 0), ",")(s))
        EskiDeger(1, s) = Trgt.Row: EskiDeger(2, s) = Trgt.Row + Trgt.Rows.Count - 1
        Durum(1, s) = Trgt.Column: Durum(2, s) = Trgt.Column + Trgt.Columns.Count - 1
        If Application.CountIf(Trgt, "=" & Cells(Trgt.Row, Trgt.Column).Value) = Trgt.Rows.Count * Trgt.Columns.Count Then _
        Chng(s) = True Else Chng(s) = False
    Next s
    ReDim EskiDeger(Application.Min(EskiDeger) To Application.Max(EskiDeger), Application.Min(Durum) To Application.Max(Durum))
    ReDim Durum(LBound(EskiDeger, 1) To UBound(EskiDeger, 1), LBound(EskiDeger, 2) To UBound(EskiDeger, 2))
    For Each R In Target
        If IsEmpty(R.Value) Then
            EskiDeger(R.Row, R.Column) = "boş"
            Durum(R.Row, R.Column) = "'yazdı."
        Else
            EskiDeger(R.Row, R.Column) = R.Value
            Durum(R.Row, R.Column) = "'olarak değiştirdi."
        End If
    Next R
End Sub
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 1009
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya & Adana

Cevap: İşlem Yapılmadığında Belirlenen Süre Sonra Kapanan Ex

İleti#44)  mikrenos » 13 Mar 2020 08:31

Miraç Bey, yeni deneme fırsatı bulabildim. Şuan sıkıntısız çalışıyor. Elinize sağlık. Hızlı dönüşleriniz izin çok teşekkür ederim.
Kullanıcı avatarı
mikrenos
 
Kayıt: 31 May 2019 09:09
Meslek: Coğrafya CBS
Yaş: 32
İleti: 9
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Samsun

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama
Önceki

Forum Örnek Dosyalar

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

Bumerang - Yazarkafe