Belli aralıklarla otomatik olarak farklı kayıt etme

[serdenm]

Merhabalar,

Okulda yaptığım deneylerde DDE ile bir executable programdan excel'e veri aktarıyorum (com port). Deneyler 7 saat sürebiliyor.

Normalde excelde automatic saving özelliği var. Fakat DDE ile haberleşirken bu özellik aktif olmuyor. Geçen gün 5 saatlik deneyin sonlarina doğru elektrik kesildi ve hiç bir veriyi kurtaramadım. Dosya kurtarılmış gözüküyor fakat içi boş.

Her 5 veya 10 dakikada bir aktif workbook u otomatik olarak ser01.xls, ser02.xls,... şeklinde kayıt edecek makroyu yazabilir misiniz?
Bu kodun çalışabilmesi için kodu nereye yazmalıyım? Çünkü DDE ile haberleşirken kodun çalışmama ihtimali olabilir.

Şimdiden teşekkür ederim.

 

[sinbade]

AutoSafe diye bir eklenti var elimde...
Araçlar > Eklentiler'den bu eklentiyi yüklediğinizde dosyanızı belli aralıklarla kaydedebiliyorsunuz.
Umarım işinizi görür...

Kolay gelsin...

 

[hamitcan]

Sub AUTO_OPEN()
calis
End Sub
Sub calis()
     Application.OnTime Now + TimeValue("00:05:00"), "my_Procedure"
End Sub
Sub my_procedure()
    yol = "C:\"
    ActiveWorkbook.Save
    ActiveWorkbook.SaveCopyAs yol & "ser" & Format(Now, "yyyy.mm.dd_hh.mm.ss") & ".xls"
    calis
End Sub

 

[baydeniro]

Paylaşım için çok teşekkür ederim.

 

[serdenm]

Herkese tesekkur ederim.
Hamitcan bu kod loop lu mu? yani her 5 dakikada bir calisir mi? Döngüyü göremedim o yüzden sordum.

Zaman aralığının 5 saniye yapıp deneme yaptım. Fakat bir şey olmuyor. Bunun otomatik olması gerekiyor (autoopen gibi).

 

[hamitcan]

Koda bir eklenti yaptım. Dosya açıldığında kod aktif hale geliyor. Her 5 dakikada bir kaydediyor. Dediğiniz gibi bir döngü halinde çalışıyor.

 

[serdenm]

Hamitcan, teşekkür ederim.

Umarım DDE ile haberleşirken bu kod çalışır.

Bu hafta deneyeceğim.

 

[serdenm]

Hamitcan Günaydın,
Bir şey dikkatimi çekti. Dosyayı kapatıp açtığımda haliyle yine dosyalari ser01.xls,... olarak oluşturmaya başlıyor. Fakat varolan dosyaların üstüne uyarmadan yazıyor. Onun yerine adlandırmayı o günü ve saat+dakika+saniyeyi kullanarak yapabilir miyiz? Örneğin;
"ser_2009-10-03_08:22:33.xls"
şeklinde.

Teşekkürler.

 

[hamitcan]

Kodu değiştirdim, bir de böyle deneyin.

 

[serdenm]

Teşekkürler çalışıyor.
Ana dosyamda bir modül içerisinde aşağıdaki kodlar var. Sizin yazdığınız kodu bu modül içerisinde en başa ekleyeceğim. Sizce Çalışmada sorun olur mu? bu kod xxx.exe dosyası ile haberleşerek çeşitli verileri excel e her saniye aktarıyor. acaba bu kod çalışırken autoopen daki kod da çalışır mı?

Sub Start()
Static RowPointer As Long
Dim PauseTime, Start

Set DATA_1 = Worksheets("SETTING").Range("B2")
Set DATA_2 = Worksheets("SETTING").Range("B3")
Set DATA_3 = Worksheets("SETTING").Range("B4")
Set DATA_4 = Worksheets("SETTING").Range("B5")
Set DATA_5 = Worksheets("SETTING").Range("B6")
Set DATA_6 = Worksheets("SETTING").Range("B7")
Set DATA_7 = Worksheets("SETTING").Range("B8")
Set DATA_8 = Worksheets("SETTING").Range("B9")
Set DATA_9 = Worksheets("SETTING").Range("B10")
Set DATA_10 = Worksheets("SETTING").Range("B11")

Set DATA_1_SCALE = Worksheets("SETTING").Range("C2")
Set DATA_2_SCALE = Worksheets("SETTING").Range("C3")
Set DATA_3_SCALE = Worksheets("SETTING").Range("C4")
Set DATA_4_SCALE = Worksheets("SETTING").Range("C5")
Set DATA_5_SCALE = Worksheets("SETTING").Range("C6")
Set DATA_6_SCALE = Worksheets("SETTING").Range("C7")
Set DATA_7_SCALE = Worksheets("SETTING").Range("C8")
Set DATA_8_SCALE = Worksheets("SETTING").Range("C9")
Set DATA_9_SCALE = Worksheets("SETTING").Range("C10")
Set DATA_10_SCALE = Worksheets("SETTING").Range("C11")

Set LogNumber = Worksheets("SETTING").Range("F5")
Set LogTimer = Worksheets("SETTING").Range("F6")
RowPointer = Worksheets("SETTING").Range("F7")

Set DDE_APP = Worksheets("SETTING").Range("E11")
Set DDE_TOPIC = Worksheets("SETTING").Range("F11")



For MaxLog = 1 To LogNumber
If dde_break Then Exit For


PauseTime = LogTimer
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop



If RowPointer = 0 Then RowPointer = 1
Sheets("SETTING").Cells(7, 7).Formula = RowPointer
Sheets("SETTING").Cells(7, 8).Formula = dde_break

RowPointer = RowPointer + 1


MYTIME = Time
MYDATE = Date


ChannelNum = DDEInitiate(DDE_APP, DDE_TOPIC)
Sheets("DATA").Cells(RowPointer, 1).Formula = MYDATE
Sheets("DATA").Cells(RowPointer, 2).Formula = MYTIME

If DATA_1 > 0 Then

F1 = DDERequest(ChannelNum, DATA_1)
DataRecord$ = F1(1) / DATA_1_SCALE

Sheets("DATA").Cells(RowPointer, 3).Formula = DataRecord$
Else
Sheets("DATA").Cells(RowPointer, 3).Formula = 0
End If

If DATA_2 > 0 Then

F1 = DDERequest(ChannelNum, DATA_2)
DataRecord$ = F1(1) / DATA_2_SCALE
Sheets("DATA").Cells(RowPointer, 4).Formula = DataRecord$
Else
Sheets("DATA").Cells(RowPointer, 4).Formula = 0
End If

If DATA_3 > 0 Then

F1 = DDERequest(ChannelNum, DATA_3)
DataRecord$ = F1(1) / DATA_3_SCALE
Sheets("DATA").Cells(RowPointer, 5).Formula = DataRecord$
Else
Sheets("DATA").Cells(RowPointer, 5).Formula = 0
End If

If DATA_4 > 0 Then
F1 = DDERequest(ChannelNum, DATA_4)
DataRecord$ = F1(1) / DATA_4_SCALE
Sheets("DATA").Cells(RowPointer, 6).Formula = DataRecord$
Else
Sheets("DATA").Cells(RowPointer, 6).Formula = 0
End If

If DATA_5 > 0 Then
F1 = DDERequest(ChannelNum, DATA_5)
DataRecord$ = F1(1) / DATA_5_SCALE
Sheets("DATA").Cells(RowPointer, 7).Formula = DataRecord$
Else
Sheets("DATA").Cells(RowPointer, 7).Formula = 0
End If


If DATA_6 > 0 Then
F1 = DDERequest(ChannelNum, DATA_6)
DataRecord$ = F1(1) / DATA_6_SCALE
Sheets("DATA").Cells(RowPointer, 8).Formula = DataRecord$

Else
Sheets("DATA").Cells(RowPointer, 8).Formula = 0
End If

If DATA_7 > 0 Then
F1 = DDERequest(ChannelNum, DATA_7)
DataRecord$ = F1(1) / DATA_7_SCALE
Sheets("DATA").Cells(RowPointer, 9).Formula = DataRecord$
Else
Sheets("DATA").Cells(RowPointer, 9).Formula = 0
End If

If DATA_8 > 0 Then
F1 = DDERequest(ChannelNum, DATA_8)
DataRecord$ = F1(1) / DATA_8_SCALE
Sheets("DATA").Cells(RowPointer, 10).Formula = DataRecord$
Else
Sheets("DATA").Cells(RowPointer, 10).Formula = 0
End If

If DATA_9 > 0 Then
F1 = DDERequest(ChannelNum, DATA_9)
DataRecord$ = F1(1) / DATA_9_SCALE
Sheets("DATA").Cells(RowPointer, 11).Formula = DataRecord$
Else
Sheets("DATA").Cells(RowPointer, 11).Formula = 0
End If

If DATA_10 > 0 Then
F1 = DDERequest(ChannelNum, DATA_10)
DataRecord$ = F1(1) / DATA_10_SCALE
Sheets("DATA").Cells(RowPointer, 12).Formula = DataRecord$
Else
Sheets("DATA").Cells(RowPointer, 12).Formula = 0
End If




DDETerminate ChannelNum
Next MaxLog
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[hamitcan]

Bence sonuna ekleseniz daha iyi. Verileri aktardıktan sonra dosyayı kaydetmesi daha mantıklı öyle değil mi? Kod çakışması olur mu derseniz, deneyerek bulabilirsiniz diye düşünüyorum.