Excel otomatik farklı kaydetme

Bu konuyu okuyanlar

refleksif24

Öğrenci
Katılım
11 Şubat 2016
Mesajlar
2
Reaksiyon puanı
0
Puanları
1
excelde çalışırken, benim belirlediğim bir klasöre otomatik olarak 5 dakikada bir kaydetsin istiyorum.

bazen çalışırken excel donuyor. en son kaydıda otomatik kurtarmada 20 - 25 dakikaları bulabiliyor. bunun önüne geçmek için 5 dakikada bir yere farklı kaydetsin istiyorum.

olur mu?
 

algea

Doçent
Katılım
15 Temmuz 2011
Mesajlar
505
Reaksiyon puanı
22
Puanları
18
Macro kullanarak bunu başarabilirsin. Application.Ontime yöntemi sanırım senin aradığın şey. Aşağıdaki makroyu projene ekle. Benim yaptığım örnekte TimerValue 5 sn olarak ayarladım bu değeri değiştirerek istediğin zaman aralığında projenin kendinin yadeğini almasını sağlayabilirsin.
Kod:
Dim TimerActive As Boolean
Dim TimerValue As String
Dim FileCounter As Integer
Sub StartTimer()
    TimerValue = "00:00:05" 
    WaitTimer = pTimerValue
    Start_Timer
End Sub

Private Sub Start_Timer()
    TimerActive = True
    Application.OnTime Now() + TimeValue(TimerValue), "Timer"
End Sub

Private Sub Stop_Timer()
    TimerActive = False
End Sub

Private Sub Timer()
    If TimerActive Then
        SaveWorkBook
        Application.OnTime Now() + TimeValue(TimerValue), "Timer"
    End If
End Sub

Sub SaveWorkBook()
    Dim FileName As String
    FileName = Application.ActiveWorkbook.FullName + "." + Format(FileCounter, "000") + ".xlsm"
    FileCounter = FileCounter + 1
    ActiveWorkbook.SaveCopyAs FileName
End Sub
En son olarak BuÇalışmakitabı'na açıldığı zaman makronun çalışması için aşağıdaki code'u ekle
Kod:
Private Sub Workbook_Open()
     StartTimer
End Sub
İyi çalışmalar.
 

algea

Doçent
Katılım
15 Temmuz 2011
Mesajlar
505
Reaksiyon puanı
22
Puanları
18
Code'da SaveWorkBook fonksiyonunda aşağıdaki gibi düzenleme yaparsan daha profesyonel sonuçlar alabilirsin ve eski backup dosyaların zarar görmez.
Kod:
Sub SaveWorkBook()
    Dim FileName As String
    Dim FileTime As String
    Dim d As Date
    d = Now()
    FileTime = Format(Year(d), "0000") + Format(Month(d), "00") + Format(Day(d), "00") + Format(Hour(d), "00") + Format(Minute(d), "00")
    FileName = Application.ActiveWorkbook.FullName + "." + FileTime + ".xlsm"
    FileCounter = FileCounter + 1
    ActiveWorkbook.SaveCopyAs FileName
End Sub
 
Üst