Revision: 43814
Initial Code
Initial URL
Initial Description
Initial Title
Initial Tags
Initial Language
at March 31, 2011 07:59 by ram321
Initial Code
Option Explicit Public dTime5min As Date Public dTime5sec As Date Public bTimeTick As Boolean Public dTimeTick As Date Sub Timer5min() Dim h As Integer, m As Integer Dim isell As Integer Dim ibuy As Integer Dim bCont As Boolean Dim dt As Date Dim min As Integer Dim lot As Integer Dim lot_s As Integer ' Break real-time calculation On Error Resume Next Application.OnTime EarliestTime:=dTime5sec, Procedure:="Timer5sec", Schedule:=False shtDDE.Range("F2").Value = 0 On Error GoTo 0 ' Set new 5-min event dTime5min = Now + TimeValue("00:05:00") dTime5min = dTime5min - TimeValue("00:00:" & itoa00(Second(dTime5min))) min = Minute(dTime5min) min = min - Int(min / 5) * 5 dTime5min = dTime5min - TimeValue("00:" & itoa00(min) & ":00") Application.OnTime dTime5min, "Timer5min" ' Update sheet shtDDE.Calculate If IsNumeric(shtDDE.Range("B2").Value) = True And _ IsNumeric(shtDDE.Range("C2").Value) = True And _ IsDate(shtDDE.Range("D2").Value) = True And _ IsDate(shtDDE.Range("E2").Value) = True Then ' Update DB h = Hour(shtDDE.Range("D2").Value) m = Minute(shtDDE.Range("D2").Value) If (h < 8) Or (h > 22) Or (h = 22 And m > 0) Then ' DAX is closed Else bCont = True If bTimeTick = True Then If dTimeTick = shtDDE.Range("D2").Value Then bCont = False End If End If 'If dTimeTick <> shtDDE.Range("D2").Value Then If bCont Then Application.ScreenUpdating = False ' main algo isell = shtTradingDAX.Range("isell").Value ibuy = shtTradingDAX.Range("ibuy").Value lot = shtTradingDAX.Range("lot_enter").Value lot_s = shtTradingDAX.Range("lot_enter_s").Value Call DBDaxUpdate2 ' play sound buy/sell If isell = 1 And CInt(shtTradingDAX.Range("isell").Value) = 0 Then ' play sound "BUY" 'If lot_s > 0 Then PlayWavFile "buy.wav", False 'End If If lot_s > 0 Then ' send signal to the web server ' undo... ' Call WebServer_SendSignal( _ ' shtDDE.Range("E2").Value, shtDDE.Range("D2").Value, _ ' "AX", "buy", shtDDE.Range("B2").Value) End If End If If isell = 0 And CInt(shtTradingDAX.Range("isell").Value) = 1 Then ' play sound "SELL" 'If shtTradingDAX.Range("lot_enter_s").Value > 0 Then PlayWavFile "sell.wav", False 'End If If shtTradingDAX.Range("lot_enter_s").Value > 0 Then ' send signal to the web server ' undo... ' Call WebServer_SendSignal( _ ' shtDDE.Range("E2").Value, shtDDE.Range("D2").Value, _ ' "AX", "sell", shtDDE.Range("B2").Value) End If End If If ibuy = 1 And CInt(shtTradingDAX.Range("ibuy").Value) = 0 Then ' play sound "SELL" 'If lot > 0 Then PlayWavFile "sell.wav", False 'End If If lot > 0 Then ' send signal to the web server ' undo... ' Call WebServer_SendSignal( _ ' shtDDE.Range("E2").Value, shtDDE.Range("D2").Value, _ ' "AX", "sell", shtDDE.Range("B2").Value) End If End If If ibuy = 0 And CInt(shtTradingDAX.Range("ibuy").Value) = 1 Then ' play sound "BUY" 'If shtTradingDAX.Range("lot_enter").Value > 0 Then PlayWavFile "buy.wav", False 'End If If shtTradingDAX.Range("lot_enter").Value > 0 Then ' send signal to the web server ' undo... ' Call WebServer_SendSignal( _ ' shtDDE.Range("E2").Value, shtDDE.Range("D2").Value, _ ' "AX", "buy", shtDDE.Range("B2").Value) End If End If ' real-time If shtDDE.Range("F2").Value <> 0 Then ' Start real-time calculation dTime5sec = Now + TimeValue("00:00:05") Application.OnTime dTime5sec, "Timer5sec" End If Application.ScreenUpdating = True End If End If End If ' save a new tick date Call SaveLastTickDate End Sub Sub Timer5sec() dTime5sec = Now + TimeValue("00:00:05") Application.OnTime dTime5sec, "Timer5sec" ' Update sheet shtDDE.Calculate ' Real-time calculation Application.ScreenUpdating = False If shtDDE.Range("F2").Value = 1 Then '-------------------------------------- '-------------------------------------- shtDDE.Range("F2").Value = 0 '-------------------------------------- '-------------------------------------- 'Call RealTimeCheck(shtDAX, "B2", shtTradingDAX) End If If shtDDE.Range("F2").Value = 0 Then ' Break real-time calculation On Error Resume Next Application.OnTime EarliestTime:=dTime5sec, Procedure:="Timer5sec", Schedule:=False On Error GoTo 0 End If Application.ScreenUpdating = True End Sub Sub MyTimerOff() On Error Resume Next Application.OnTime EarliestTime:=dTime5min, Procedure:="Timer5min", Schedule:=False Application.OnTime EarliestTime:=dTime5sec, Procedure:="Timer5sec", Schedule:=False On Error GoTo 0 End Sub Public Sub btnStopTimer() Call MyTimerOff MsgBox "5min timer is stoped now. Use ""Recovery"" button to restart it" End Sub Public Sub btnStartTimer(Optional bShowMsg As Boolean = True) ' kill timers Call MyTimerOff ' start a new 5min timer Dim min As Integer min = Minute(Now) min = min - 5 * Int(min / 5) dTime5min = Now + TimeValue("00:0" & Trim(CStr(5 - min)) & ":00") Dim sec As Integer sec = Second(dTime5min) dTime5min = dTime5min - TimeValue("00:00:" & itoa00(sec)) Application.OnTime dTime5min, "Timer5min" ' get last DDE time value Call SaveLastTickDate If bShowMsg = True Then MsgBox "5min timer has been started" End If End Sub Sub SaveLastTickDate() If IsDate(shtDDE.Range("D2").Value) = False Then bTimeTick = False Else bTimeTick = True dTimeTick = shtDDE.Range("D2").Value End If End Sub Sub btnCloseMonth() Call DBEndOfMonth("B2", shtTradingDAX) MsgBox "Done" End Sub Sub DBDaxUpdate2() Call UpdateDB(shtDAX, "B2", shtTradingDAX) Dim sFile As String sFile = ThisWorkbook.Path & "\DAX-" & Trim(CStr(Year(shtDDE.Range("B2").Cells(1, 4).Value))) & "-" If Month(shtDDE.Range("B2").Cells(1, 4).Value) < 10 Then sFile = sFile & "0" End If sFile = sFile & Trim(CStr(Month(shtDDE.Range("B2").Cells(1, 4).Value))) & ".txt" 'sFile = ...\DAX-YYYY-MM.txt 'Call WriteToFile(sFile, shtDAX, "B2") 'sFile = ...\DAX.txt sFile = ThisWorkbook.Path & "\DAX.txt" 'Call WriteToFile(sFile, shtDAX, "B2") End Sub Function FileExists(ByVal FileSpec As String) As Boolean Dim Attr As Long On Error Resume Next Attr = GetAttr(FileSpec) If Err.Number = 0 Then FileExists = Not ((Attr And vbDirectory) = vbDirectory) End If End Function Sub WriteToFile(sFileName As String, sht As Worksheet, sRange As String) Dim iFile As Integer Dim fLast As Double Dim iVolume As Long Dim sTime As String Dim sDate As String Dim signalBB As Integer Dim signalBS As Integer Dim signalSS As Integer Dim signalSB As Integer Dim equity_perday As Variant Dim equitys_perday As Variant ' open text file to writenew signal iFile = FreeFile If FileExists(sFileName) Then ' append to file Open sFileName For Append Shared As iFile Else ' make new file Open sFileName For Output As iFile End If fLast = shtDDE.Range(sRange).Cells(1, 1).Value iVolume = shtDDE.Range(sRange).Cells(1, 2).Value sTime = WorksheetFunction.Text(shtDDE.Range(sRange).Cells(1, 3).Value, "hh:mm:ss") sDate = WorksheetFunction.Text(shtDDE.Range(sRange).Cells(1, 4).Value, "dd.mm.yyyy") signalBB = 0 If sht.Range("A1").End(xlDown).Cells(1, 29).Value Then signalBB = 1 signalBS = 0 If sht.Range("A1").End(xlDown).Cells(1, 30).Value Then signalBS = 1 signalSS = 0 If sht.Range("A1").End(xlDown).Cells(1, 31).Value Then signalSS = 1 signalSB = 0 If sht.Range("A1").End(xlDown).Cells(1, 32).Value Then signalSB = 1 equity_perday = shtTradingDAX.Range("equity_perday").Value equitys_perday = shtTradingDAX.Range("equitys_perday").Value Write #iFile, fLast, iVolume, sTime, sDate, signalBB, signalBS, signalSS, signalSB, equity_perday, equitys_perday Close #iFile End Sub
Initial URL
Initial Description
Initial Title
automated trading - code vba 1
Initial Tags
Initial Language
Visual Basic