ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[sinanplater]

Bi örnekte ben ekleyeyim o zaman;

Kod: Tümünü seç

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("01:00:00")
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=True
End Sub


Kod: Tümünü seç

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=False
End Sub


Kod: Tümünü seç

Sub ShutDown()
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Saved = True
        .Close
    End With
End Sub


Kod: Tümünü seç

Private Sub Workbook_Open()
    Call SetTimer
End Sub

Kod: Tümünü seç

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub

Kod: Tümünü seç

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
End Sub


Kod: Tümünü seç

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    Call StopTimer
    Call SetTimer
End Sub


[MERAK]

Sayın Enes BAĞ, internetimde sorun olduğu için henüz evde deneyemedim.
Sayın sinanplater, sizin eklediğiniz örnekle tam olarak ne yapabiliyoruz?

[By_MeMo_54]

s.a konuyu konuşalı uzun zaman olmuş ma bana yardımcı olacak birilier vardır diye düşünüyorum.

ağda ortak kullanılan bir excel tablomuz var toplamda 10 dakikada excel çalışma sayfasını kapatacak ilk 5. dakikada" 5 dk sonra excel dosyası kapanacaktır" uyarısı verecek ve sonra toplamda 10. dakikada exceli son haliyle kaydedip kapatacak

yardımcı olursanız sevinirim bu konuda çok muzdaribim

[Erkan Akayay]

Madde 20: Mesaj yazarken büyük harf kullanmak bağırmak anlamına geleceği için kesinlikle mesajınızın tamamını büyük harf kullanarak yazmayınız. Türkçe yazım kurallarında; cümlede kelimelerin ilk harfi büyük olur, özel isimlerin baş harfi büyük olur, noktadan sonra başlayan her kelimenin baş harfi büyük olur, mesaj içindeki tüm harfler büyük yazılmaz yahut tümü küçük yazılmaz. Sitemiz Türkçe karakter desteklemektedir ve i, ç , ş , ğ gibi harfleri kullanmanızda hiç bir sakınca yoktur.

[By_MeMo_54]

Örnekteki tablo ortak kullanılan bir tablo diğer kullanıcılardan birisi bu tabloyu kapatmadığı zaman diğer kullanıcılar değişiklik yapamıyor salt okunur görütüleyemiyor. Unutan kullanıcılar yüzünden iş aksayabiliyor bende bu dosyaya işlem yapılmadan 10 dakika durduğu zaman kendi kendine kaydedip excel dosyasını kapatmasını istiyorum. 5. dakikada " işlem yapılmaz ise 5 dakika sonra dosya otomatik olarak kaydedilecek ve kapatılacak" şeklinde uyarı mesajı vermesini istiyorum. Yardımcı olursanız sevinirim.

rnek.rar

[By_MeMo_54]

Yardımcı olabilecek kimse yok mu?

[Ali ÖZ]

Ekli dosyayı kendinize uyarlayabilirsiniz.

[By_MeMo_54]

Ekli dosyayı kendinize uyarlayabilirsiniz.

Ali bey excel konusunda çok iyi değilim uyarlayamadığım için böyle bir talepte bulunmuştum.

[EminP]

Merhaba,

Bahsedeceğim konuyla ilgili çok başlık ve bilgi var aslında. Neredeyse hepsini de inceledim ama bilgi eksikliğimden dolayı uyarlama yapamadım. En uygun başlık burayı bulduğum için buradan tetiklemek istedim. Yüzeysel bir ifadeyle "Açık olan tüm excel dosyalarını kaydetmeden kapatmak istiyorum." denebilir ama en uygun çözüm önerisinde bulunabilmeniz adına olayı şöyle anlatayım:

Bir işyeri hekimi müşterim var ve 3-4 bin kişilik bir fabrikaya hizmet veriyor. Kullandığı yazılım üzerinden sürekli excel'e veri gönderiyor ve birkaç dğişiklik yapıp yazıcıdan çıktı alıyor(İşe giriş formu, raporlar, listeler vs.). İşini bitirdikten sonra da bu dosyaları kapatmadığı için gün ortasında 300-400 tane açık excel dosyası oluşuyor. Dosya isimleri değişken. Yazılım xlt uzantılı şablonları kullandığı için aynı formları tekrar tekrar excel'e gönderdiğinde rapor1, rapor2, rapor3, liste1, liste2 vb. şekilde dosyalar oluşuyor.

Murat Bey'in verdiği örnekteki dosyayı açınca örneğin 1 dk. süre girdiğimizde hareket algılamazsa 1 dk. sonra dosyayı kapatıyor. Kodda değişiklik yaparak, açık olan tüm excel dosyalarında 1 dk. içinde hareket olmazsa kapanmalarını sağlayabilir miyiz?

Bir de şöyle bir mesele var: Diyelim bir xlsm oluşturduk ve dosyayı çalıştırdığımızda açık olan tüm excel'leri kaydetmeden kapattı. Hemen arkasından kullanıcı tarafından yeni excel dosyaları tekrar oluşturulmaya başlanacak. Buna nasıl bir çözüm getirilebilir? Biriktiğinde kapatma dosyasını tekrar mı çalıştırması gerekir? Biraz uzattım ama konuyu tam olarak anlatabilmek istedim.

Yardımlarınızı bekler, saygılar sunarım.

[Tarkan VURAL]

Merhaba, hoş geldiniz.

Diyelim bir xlsm oluşturduk ve dosyayı çalıştırdığımızda açık olan tüm excel'leri kaydetmeden kapattı. Hemen arkasından kullanıcı tarafından yeni excel dosyaları tekrar oluşturulmaya başlanacak. Buna nasıl bir çözüm getirilebilir? Biriktiğinde kapatma dosyasını tekrar mı çalıştırması gerekir?

Burada yazdıklarınıza istinaden birikme nedir? Tam olarak tanımlayınız.
Örnek :
10 tane açık dosya varsa kapatma uygulaması çalışsın.
Saat 12:00 de kapatma dosyası çalışsın.
Kullanıcı Excel dosyalarını hiç bir zaman oluşturmasın
vb..

Timer kullanarak ufak bir exe uygulama, windows servis, ya da görev zamanlayıcı kullanılarak bir vbs file, batch file, Excel vb.. uygulamalardan tetik verilebilir.

Özetle iki durum var:
1 - Tetiklemeyi ne tür bir uygulama istasyonu yapacak ?
2 - Tetikleme hangi şarta dayalı olmak üzere başlatılacak ?

Kolay gelsin.

(Hemen yanıt dönüşü yapsanız da; ben uygun olamadıkça yanıt veremeyebilirim, dipnot olarak bilginize. )

[EminP]

Tarkan Bey merhaba,

Verdiğiniz fikir için teşekkür ederim. Ben hep makro üzerinden çözüm bulmaya çalışıyordum ama bat dosyası ile de sorunuma çözüm bulunabiliyormuş. Yönlendirme için tekrar teşekkürler.

[Tarkan VURAL]

Rica ederim
Amaç çözüm bulmaksa, illa işin içinde Excel olmak zorunda değil. En hızlı ve mantıklı çözüme gidiyor olmak kafii...

Kolay gelsin.

[judlas]

Üstadım merhaba gayet güzel ve kullanışlı bir kod.
Ben sizden şunu rica etsem. Excel kitabımızı açtığımızda karşımıza süre girmek için çıkan inputboxa 00:00:25 gibi bir şeyi yazmak yerine bu inputbox yine kalsın aşağıya ise bir kaçtane option buton koysak işte her option buton karşısında aşağıdaki seçebileceğim bir kaç tane zaman olsa. ben bu zamanlardan birisini seçince inputboxa format olarak o zamanın formatı yerleşse olabilir mi. bilgi ve yardımlarınızı rica ederim
5 dk
10dk
30sn
30dk
45dk
60dk

Excel'de bir işlem yapılmadığında belirlediğiniz süre sonra kendiliğinden kapanmasını istiyorsanız.

Kod: Tümünü seç

   
Option Explicit

Private Const Gecikme As Date = 5 / 86400
Private Const Onerilen_Zaman As Date = 10 * 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:="ThisWorkbook.TimeSlot", Schedule:=False
    If IsMissing(Reset) Or (Reset = False) Then
        If (Zaman <= Gecikme) Then
            ThisWorkbook.Close True
        End If
        Zaman = Zaman - Gecikme
    Else
        Zaman = Süre
    End If
    Temps = Now + Gecikme
    Application.OnTime Temps, Procedure:="ThisWorkbook.TimeSlot"
    ActiveWindow.Caption = Split(ActiveWindow.Caption, " [")(0) & " [" & Zaman & "]"
End Sub

Private Sub Workbook_Open()
    Do
        Süre = Application.InputBox("Varsayılan zaman önerilmektedir " & Onerilen_Zaman & ". " & _
        "Girdi formatı '00:00:00'" & vbCrLf & vbCrLf & _
        "Kalan süre yukarıda gösterilecektir. " & vbCrLf, _
        "Saati ayarlayın", Type:=2)
    Loop Until (Süre = False) Or IsDate(Süre)
    Süre = IIf(IsDate(Süre), Süre, Onerilen_Zaman)
    TimeSlot True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    TimeSlot True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime Temps, Procedure:="ThisWorkbook.TimeSlot", Schedule:=False
End Sub

[mikrenos]

Merhaba,
Öncelikle elinize sağlık. Excel açıldığında ekrana gelen uyarıyı kullanıcı kontrolünden çıkarılıp kod içine sabitlenebilir mi? Örnek olarak excel açıldığında işlem yapılmadığı andan itibaren 5 dk sonra kapanması gerekiyor. Çünkü kullanıcı uzun süreler verdiğinde yine amacına ulaşabilecek.

[Tarkan VURAL]

Merhaba, hoş geldiniz. İletinizin bir üstündeki alıntıda kod içine sabit görünüyor. İnceleyebildiniz mi ?

[mikrenos]

Merhaba, hoş geldiniz. İletinizin bir üstündeki alıntıda kod içine sabit görünüyor. İnceleyebildiniz mi ?

Merhaba Tarkan Bey,
Kod bilgim zayıf ancak açıklamaya çalışayım. Tablo açıldığında kod içinde belirlenmiş önerilen bir süre kullanıcının değiştirebileceği küçük bir pencerede açılıyor. Kullanıcı süreyi on saat belirleyebilir durumda.
Eğer bu pencere yerine excel açıldığında sayaç kod içinde belirlenen sürede geri sayıma başlayabilirse benim açımdan faydalı olacaktır.
Tarkan Bey, süreye takılsamda kodu kullanıyorum ancak takıldığım diğer nokta şu. Paylaşım alanında ağ çok yavaş olduğu için excel kaydedilip kapanırken öylece kalıyor. Tablonun kaydedilmeden kapanması için değişikli yapılabilir mi?

[mikrenos]

Merhaba, hoş geldiniz. İletinizin bir üstündeki alıntıda kod içine sabit görünüyor. İnceleyebildiniz mi ?

Merhaba Tarkan Bey,
Bir önceki mesajımda belirttiğim durumları düzelttim ilginiz için teşekkür ederim.

[feraz]

Üstadım merhaba gayet güzel ve kullanışlı bir kod.
Ben sizden şunu rica etsem. Excel kitabımızı açtığımızda karşımıza süre girmek için çıkan inputboxa 00:00:25 gibi bir şeyi yazmak yerine bu inputbox yine kalsın aşağıya ise bir kaçtane option buton koysak işte her option buton karşısında aşağıdaki seçebileceğim bir kaç tane zaman olsa. ben bu zamanlardan birisini seçince inputboxa format olarak o zamanın formatı yerleşse olabilir mi. bilgi ve yardımlarınızı rica ederim
5 dk
10dk
30sn
30dk
45dk
60dk

Excel'de bir işlem yapılmadığında belirlediğiniz süre sonra kendiliğinden kapanmasını istiyorsanız.

Kod: Tümünü seç

   
Option Explicit

Private Const Gecikme As Date = 5 / 86400
Private Const Onerilen_Zaman As Date = 10 * 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:="ThisWorkbook.TimeSlot", Schedule:=False
    If IsMissing(Reset) Or (Reset = False) Then
        If (Zaman <= Gecikme) Then
            ThisWorkbook.Close True
        End If
        Zaman = Zaman - Gecikme
    Else
        Zaman = Süre
    End If
    Temps = Now + Gecikme
    Application.OnTime Temps, Procedure:="ThisWorkbook.TimeSlot"
    ActiveWindow.Caption = Split(ActiveWindow.Caption, " [")(0) & " [" & Zaman & "]"
End Sub

Private Sub Workbook_Open()
    Do
        Süre = Application.InputBox("Varsayılan zaman önerilmektedir " & Onerilen_Zaman & ". " & _
        "Girdi formatı '00:00:00'" & vbCrLf & vbCrLf & _
        "Kalan süre yukarıda gösterilecektir. " & vbCrLf, _
        "Saati ayarlayın", Type:=2)
    Loop Until (Süre = False) Or IsDate(Süre)
    Süre = IIf(IsDate(Süre), Süre, Onerilen_Zaman)
    TimeSlot True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    TimeSlot True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime Temps, Procedure:="ThisWorkbook.TimeSlot", Schedule:=False
End Sub

Daha geçerliyse soru şu şekilde olabilir.Açılışta nir userform çağırılır ve userformda zaten dediğiniz olaylar yani optionbuttonlar ekleniyor

[mikrenos]

Merhaba,

@MuratOSMA (time slot)ve @Faruk AKARÇAY ın hazırladığı(log) excellerde çalışan makroları birleştimek istiyorum ancak ThisWorkBookta bulunan kodları birleştiremedim. Ekte iki dosya mevcut.

@Faruk AKARÇAY ın hazırladığı Log kaydı yapan makro çoklu hücre silinmesi sonrası log kaydı girmiyor. Bu konuda da yardımcı olabilir misiniz.

Yardımlarınız için teşekkür ederim.

-Farklı bir konu altına aynı iletiyi yazmıştım ancak cevap gelmediğinden bu başlık altına da yazmak istedim

[Miraç CAN]

Merhaba,

@MuratOSMA (time slot)ve @Faruk AKARÇAY ın hazırladığı(log) excellerde çalışan makroları birleştimek istiyorum ancak ThisWorkBookta bulunan kodları birleştiremedim. Ekte iki dosya mevcut.

@Faruk AKARÇAY ın hazırladığı Log kaydı yapan makro çoklu hücre silinmesi sonrası log kaydı girmiyor. Bu konuda da yardımcı olabilir misiniz.

Yardımlarınız için teşekkür ederim.

-Farklı bir konu altına aynı iletiyi yazmıştım ancak cevap gelmediğinden bu başlık altına da yazmak istedim

Teorik olarak böyle ama deneme fırsatım olmadı.

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