※ Elliott Pattern Helper Add In
'차트와 지표' 네 번째 글입니다. 기술적 지표(Technical Indicator)를 구현하여 활용하는 과정을 진행하기에 앞서 현재까지 작성한 VBA 프로그램을 몇 군데 개선하도록 하는게 좋을 것 같습니다.
수정할 사항을 정리하면 다음과 같습니다.
- DDE Item에서 종목코드를 parsing하는 로직 ▷ 'onStart' sub모듈 수정
- 캔들정보 축적을 위한 종목 선택 시나리오 ▷ 'FSchedule' 폼 수정
- CCandleFeeder 할당 로직 ▷ 'prepareSheet', 'storeCandleInfo' 수정
- 차트 전환 시 깜빡거림 제거 ▷ 'onChartChange' sub모듈 수정
※ 수정사항을 반영한 엑셀 파일(엑셀 2007에서 작성)입니다. ☞
▶ 첫째 항목, 'onStart' 수정
※ (수정 전 'onStart' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub onStart_bak(i)
On Error GoTo EH_onStart:
aLinks = ActiveWorkbook.LinkSources(xlOLELinks)
c_str = aLinks(i)
t_str = Replace(c_str, "KHRun|", "")
t_str = Replace(t_str, "!13", "")
Call storeCandleInfo(t_str)
Exit Sub
EH_onStart:
MsgBox "Error(" & Err.Number & ") " & Err.Description & Err.Source '" [onStart]"
Call Stop_Click
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ DDE 이벤트에 의해 호출될 때마다 종목코드를 찾기 위해 스트링 연산을 합니다.
※ (수정 후 'onStart' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private alnk As Collection '▶ 전역변수 추가, collection of stock codes
Sub registerLinks()
aLinks = ActiveWorkbook.LinkSources(xlOLELinks)
If Not IsEmpty(aLinks) Then
Set alnk = New Collection
For i = 1 To UBound(aLinks)
l_str = aLinks(i)
If InStr(l_str, "!13") > 8 Then
posl = InStr(l_str, "|")
posr = InStr(l_str, "!")
s_code = Mid(l_str, posl + 1, posr - posl - 1)
alnk.Add s_code, CStr(i)
Debug.Print "stored s_code for " & i & " " & s_code
End If
Next i
End If
End Sub
Sub onStart(i)
On Error GoTo EH_onStart:
Call storeCandleInfo(alnk.Item(CStr(i))) Exit Sub
EH_onStart:
MsgBox "Error(" & Err.Number & ") " & Err.Description & Err.Source '" [onStart]"
Call Stop_Click
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 'alnk' 전역변수와 추출된 종목코드를 'alnk'에 저장하는 'registerLinks' sub모듈이 추가되었습니다.
☞ 'onSchedule'에서 'registerLinks'를 호출하도록 하여 반복수행되던 스트링 연산을 한 번만 수행되도록 합니다(아래 소스 참조).
※ (수정 후 'onSchedule' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub onSchedule(ts, te, sc, cu)
Call registerLinks
Call prepareSheet(sc, cu)
If Time > TimeValue(ts) And Time < TimeValue(te) Then
Application.OnTime Now, "Start_Click"
Else
Application.OnTime TimeValue(ts), "Start_Click"
End If
Application.OnTime TimeValue(te), "Stop_Click"
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ☞ 'onSchedule'은 수정사항 두 번째 항목을 반영하는 과정에서 한 번 더 수정될 것입니다.
▶ 둘째 항목, 'FSchedule' 폼 수정
폼의 수정 방향은 다음 그림과 같습니다. 아래 오른쪽 그림과 같이 ① 폼이 팝업될 때 기존에 생성된 캔들정보 시트의 목록이 목록상자(ListBox)에 표시됩니다. ② 종목과 캔들을 선택하고 'Add' 버튼을 클릭하면 목록상자에 추가됩니다. 그리고 ③ 목록상자에 추가된 항목을 더블클릭하면 해당 항목이 목록상자에서 삭제됩니다.
① 항목을 위해 기존의 'sheets_cs' 함수를 수정합니다.
※ (수정 전 'sheets_cs' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function sheets_cs(sn) As String
For Each sh In ActiveWorkbook.Sheets
If sh.Name = sn & "-5분" Or sh.Name = sn & "-15분" _
Or sh.Name = sn & "-60분" Or sh.Name = sn & "-일" Then _
sheets_cs = sheets_cs & sh.Name & ","
Next sh
If Not (sheets_cs = Empty Or sheets_cs = "") Then _
sheets_cs = Left(sheets_cs, Len(sheets_cs) - 1)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ Input으로 받은 종목명을 포함하는 캔들정보 시트 목록을 리턴합니다.
※ (수정 후 'sheets_cs' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function sheets_cs(sn) As String
If Not sn = xlNullString Then
For Each sh In ActiveWorkbook.sheets
If sh.Name = sn & "-5분" Or sh.Name = sn & "-15분" _
Or sh.Name = sn & "-60분" Or sh.Name = sn & "-일" Then _
sheets_cs = sheets_cs & sh.Name & ","
Next sh
Else
For Each sh In ActiveWorkbook.sheets
If InStr(sh.Name, "-5분") > 1 _
Or InStr(sh.Name, "-15분") > 1 _
Or InStr(sh.Name, "-60분") > 1 _
Or InStr(sh.Name, "-일") > 1 Then _
sheets_cs = sheets_cs & sh.Name & ","
Next sh
End If
If Not (sheets_cs = Empty Or sheets_cs = "") Then _
sheets_cs = Left(sheets_cs, Len(sheets_cs) - 1)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ Input으로 받은 종목명이 Null 스트링인 경우 기존에 생성된 모든 캔들정보 시트 목록을 리턴합니다.
폼을 수정하겠습니다. 폼 'FSchedule'의 다중페이지에 새 페이지를 생성하고 종목 선택을 위한 콤보상자 'ComboBoxSN'을 추가합니다.
기존의 'Time' 페이지에 존재하는 캔들 시간단위 선택 콤보상자 'ComboBoxCT'를 새로 만든 페이지로 이동합니다.
'ButtonSCAdd' 이름으로 버튼을 추가하고 Caption을 적절히 입력합니다.
기존의 페이지 'Stocks'를 삭제하고 새로 만든 페이지의 이름을 적절히 수정합니다.
폼 'FSchedule'의 초기화 코드를 수정합니다.
※ (수정 후 'UserForm_Initialize' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private s_code As Collection '▶ 전역변수 추가
Private Sub UserForm_Initialize()
ComboBoxTS.AddItem "09:00:00"
ComboBoxTS.AddItem "10:00:00"
ComboBoxTS.AddItem "11:00:00"
ComboBoxTS.AddItem "12:00:00"
ComboBoxTS.AddItem "13:00:00"
ComboBoxTS.AddItem "14:00:00"
ComboBoxTS.AddItem "15:00:00"
ComboBoxTS.Text = "09:00:00"
ComboBoxTE.AddItem "09:00:00"
ComboBoxTE.AddItem "10:00:00"
ComboBoxTE.AddItem "11:00:00"
ComboBoxTE.AddItem "12:00:00"
ComboBoxTE.AddItem "13:00:00"
ComboBoxTE.AddItem "14:00:00"
ComboBoxTE.AddItem "15:00:00"
ComboBoxTE.Text = "15:00:00"
ComboBoxCT.AddItem "5분", 0
ComboBoxCT.AddItem "15분", 1
ComboBoxCT.AddItem "60분", 2
ComboBoxCT.AddItem "일", 3
ComboBoxCT.ListIndex = 0
s_list = getStockList()
Set s_code = New Collection
For i = LBound(s_list, 1) To UBound(s_list, 1)
If s_list(i, 1) <> "" Then
s_code.Add s_list(i, 1), s_list(i, 2)
ComboBoxSN.AddItem s_list(i, 2), i - 1
End If
Next i
ComboBoxSN.ListIndex = 0
s_list = Split(sheets_cs(xlNullString), ",")
For i = LBound(s_list) To UBound(s_list)
ListBoxSC.AddItem Replace(s_list(i), "-", " ")
Next i
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 's_code' collection은 종목명을 키로 종목코드를 저장하기 위해 사용합니다.
'ButtonSCAdd'의 이벤트 매크로를 작성합니다.
※ ('ButtonSCAdd_Click' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ButtonSCAdd_Click()
ns = ComboBoxSN.Value & " " & ComboBoxCT.Value
For i = 0 To ListBoxSC.ListCount - 1
If InStr(ListBoxSC.List(i), ComboBoxSN.Value) > 0 Then GoTo Skip:
Next i
On Error Resume Next
ListBoxSC.AddItem ns
On Error GoTo 0
Skip:
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 목록상자 'ListBoxSC'에 동일한 종목이 존재하지 않을 경우에만 추가합니다.
☞ 하나의 종목 당 하나의 캔들정보 시트만 생성하도록 제한을 둔 것입니다.
목록상자 'ListBoxSC'의 더블클릭된 항목을 목록상자로부터 제거하도록 이벤트 처리 매크로를 추가합니다.
※ ('ListBoxSC'의 더블클릭 이벤트 매크로 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ListBoxSC_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If Not ListBoxSC.ListIndex < 0 Then _
ListBoxSC.RemoveItem ListBoxSC.ListIndex
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
마지막으로 'FSchedule' 폼의 'OK' 버튼 이벤트 매크로와 이 매크로에 의해 호출되는 'onSchedule' 소스를 수정합니다.
※ ('OK' 버튼 이벤트 매크로 수정)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ButtonOK_Click()
Dim s_list As String 'comma separated selected items list
Me.Hide
For i = 0 To ListBoxSC.ListCount - 1
sitem = ListBoxSC.List(i)
sn = Split(sitem, " ")
sc = s_code.Item(sn(LBound(sn)))
sitem = Replace(sitem, " ", "(" & sc & ")")
s_list = s_list & sitem & ","
Next i
If Len(s_list) > 0 Then
s_list = Left(s_list, Len(s_list) - 1)
Call onSchedule(ComboBoxTS.Text, ComboBoxTE.Text, _
s_list) End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 'onSchedule'로 전달되는 인자의 개수가 변경되었습니다.
※ (수정 후 'onSchedule' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub onSchedule(ts, te, sc) Call registerLinks Call prepareSheet(sc)
If Time > TimeValue(ts) And Time < TimeValue(te) Then
Application.OnTime Now, "Start_Click"
Else
Application.OnTime TimeValue(ts), "Start_Click"
End If
Application.OnTime TimeValue(te), "Stop_Click"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 'prepareSheet'로 전달되는 인자의 개수 또한 변경되었습니다.
▶ 세째 항목, 'prepareSheet', 'storeCandleInfo' 수정
'CCandleFeeder'는 여러 개의 종목에 대해 각각의 상태를 유지하면서 독립적으로 동작하게끔 하려는 목적으로 클래스로 만들었습니다. 그 목적에 맞도록 소스를 수정하겠습니다.
※ (수정 전 'storeCandleInfo' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub storeCandleInfo(s_code)
Static feeders As Collection
'On Error GoTo EH_storeCandleInfo:
If feeders Is Nothing Then Set feeders = New Collection
For i = LBound(ss_list) To UBound(ss_list)
Dim cfeeder As CCandleFeeder
On Error Resume Next
Set cfeeder = feeders.Item(ss_list(i, 1))
If Err.Number = 5 Then GoTo RegisterFeeder:
On Error GoTo 0
If Not cfeeder Is Nothing Then GoTo DoFeed:
On Error GoTo EH_storeCandleInfo:
RegisterFeeder:
Set cfeeder = New CCandleFeeder
cfeeder.StockCode = ss_list(i, 1)
cfeeder.CandleSheet = ss_list(i, 2)
cfeeder.DDEsheet = dde_sheet
cfeeder.CHTsheet = CHART_POSTFIX
feeders.Add cfeeder, ss_list(i, 1)
DoFeed:
cfeeder.store (s_code)
NextLoop:
Next i
Exit Sub
EH_storeCandleInfo:
If Err.Number = 8901 Then
Debug.Print "Error(8901) " & Err.Source
Err.Clear
GoTo NextLoop:
End If
MsgBox "Error(" & Err.Number & ") " & Err.Description & " [storeCandleInfo]"
Err.Raise Err.Number, "storeCandleInfo", Err.Description
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 기존 소스는 'storeCandleInfo'가 호출될 때마다 불필요한 loop를 돌면서 이미 할당되었을 'CCandleFeeder'를 다시 할당하려고 했습니다.
☞ 이 작업을 'prepareSheet'에서 단 한 번만 수행되도록 수정합니다.
※ (수정 후 'prepareSheet' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private feeders As Collection '▶ 전역변수 추가, collection of CCandleFeeders
Function prepareSheet(slist)
Dim xlSheet As Worksheet
Dim s_arr As Variant
On Error GoTo EH_prepareSheet:
dde_sheet = ActiveSheet.Name
s_arr = Split(slist, ",")
s_cnt = UBound(s_arr) - LBound(s_arr) + 1
ReDim ss_list(1 To s_cnt, 1 To 2)
Set feeders = New Collection
For i = LBound(s_arr) To UBound(s_arr)
sn = s_arr(i)
pospl = InStr(sn, "(")
pospr = InStr(sn, ")")
cu = Right(sn, Len(sn) - pospr)
s_code = Mid(sn, pospl + 1, pospr - pospl - 1)
If s_code = Empty Or s_code = "" Then GoTo NextLoop:
sh_name = Left(sn, pospl - 1)
If sh_name = Empty Or sh_name = "" Then sh_name = s_code
sh_name = sh_name & "-" & cu
ss_list(i - LBound(s_arr) + 1, 1) = s_code
ss_list(i - LBound(s_arr) + 1, 2) = sh_name
Dim cfeeder As CCandleFeeder
Set cfeeder = New CCandleFeeder
cfeeder.StockCode = s_code
cfeeder.CandleSheet = sh_name
cfeeder.DDEsheet = dde_sheet
cfeeder.CHTsheet = CHART_POSTFIX
feeders.Add cfeeder, s_code
If Not sheetExist(sh_name) Then
Set xlSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
xlSheet.Name = sh_name
With xlSheet
.Cells(1, 1).value = "일자 / 시간"
.Cells(1, 2).value = "시가"
.Cells(1, 3).value = "고가"
.Cells(1, 4).value = "저가"
.Cells(1, 5).value = "종가"
.Cells(1, 6).value = "거래량"
End With
End If
NextLoop:
Next i
Set xlSheet = Nothing
Exit Function
EH_prepareSheet:
MsgBox "Error(" & Err.Number & ") " & Err.Description & " [prepareSheet]"
Err.Raise Err.Number, "prepareSheet", Err.Description
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 'FSchedule' 폼이 수정되면서 'onSchedule'을 거쳐 전달되는 인자의 개수가 달라졌습니다.
※ (수정 후 'storeCandleInfo' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub storeCandleInfo(s_code)
Dim cfeeder As CCandleFeeder
On Error GoTo EH_storeCandleInfo:
On Error Resume Next
Set cfeeder = feeders.Item(s_code)
If Err.Number = 5 Then Exit Sub
On Error GoTo 0
If Not cfeeder Is Nothing Then cfeeder.store (s_code)
Exit Sub
EH_storeCandleInfo:
MsgBox "Error(" & Err.Number & ") " & Err.Description & " [storeCandleInfo]"
Err.Raise Err.Number, "storeCandleInfo", Err.Description
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 'storeCandleInfo'는 해당 종목의 'CCandleFeeder'가 할당되어 있을 경우에만 작동하도록 수정되었습니다.
▶ 네째 항목, 'onChartChange' 수정
'onChartChange' sub모듈이 차트에 출력되는 종목을 전환하는 과정에서 화면이 빠르게 변하는 모습을 감추도록 수정합니다.
※ (수정 후 'onChartChange' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub onChartChange(ParamArray varArgs() As Variant)
If UBound(varArgs) < 3 Then _
Err.Raise 8902, "onChartChange", "ParamArray too short"
Dim chtRng As String, sn As String
On Error GoTo EH_onChartChange:
Application.ScreenUpdating = False
sn = Cells(2, 2).Value
If UBound(varArgs) > 3 Then sn = varArgs(4)
If sn = xlNullString Then Exit Sub
csheet = ActiveSheet.Name
chtRng = fillChartRng(csheet & "_AUX", sn, False, 2, varArgs(3))
Sheets(csheet).Select
endRow = Sheets(sn).Cells(1, 1).End(xlDown).Row
If ActiveSheet.ChartObjects.Count = 0 Then
drawChartTWH Sheets(csheet & "_AUX").Range(chtRng), _
varArgs(0), varArgs(1), varArgs(2), csheet, _
csheet & "_AUX" & "!" & Cells(1, 1).Address, _
WorksheetFunction.Max(endRow - varArgs(3) - 1, 0), _
sn
Else
Dim ch As ChartObject, sbar As ScrollBar
Set ch = Sheets(csheet).ChartObjects(1)
ch.Chart.SetSourceData Source:=Sheets(csheet & "_AUX").Range(chtRng)
ch.Name = sn
Set sbar = Sheets(csheet).ScrollBars(1)
sbar.Max = WorksheetFunction.Max(endRow - varArgs(3) - 1, 0)
sbar.Value = WorksheetFunction.Max(endRow - varArgs(3) - 1, 0)
End If
Application.ScreenUpdating = True
Exit Sub
EH_onChartChange:
MsgBox "Error(" & Err.Number & ") " & Err.Description & " [onChartChange]"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
※ 수정사항을 반영한 엑셀 파일(엑셀 2007에서 작성)입니다. ☞
폼의 수정 방향은 다음 그림과 같습니다. 아래 오른쪽 그림과 같이 ① 폼이 팝업될 때 기존에 생성된 캔들정보 시트의 목록이 목록상자(ListBox)에 표시됩니다. ② 종목과 캔들을 선택하고 'Add' 버튼을 클릭하면 목록상자에 추가됩니다. 그리고 ③ 목록상자에 추가된 항목을 더블클릭하면 해당 항목이 목록상자에서 삭제됩니다.
 |
| 그림 1. 폼 'FSchedule' 수정 방향 |
① 항목을 위해 기존의 'sheets_cs' 함수를 수정합니다.
※ (수정 전 'sheets_cs' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function sheets_cs(sn) As String
For Each sh In ActiveWorkbook.Sheets
If sh.Name = sn & "-5분" Or sh.Name = sn & "-15분" _
Or sh.Name = sn & "-60분" Or sh.Name = sn & "-일" Then _
sheets_cs = sheets_cs & sh.Name & ","
Next sh
If Not (sheets_cs = Empty Or sheets_cs = "") Then _
sheets_cs = Left(sheets_cs, Len(sheets_cs) - 1)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ Input으로 받은 종목명을 포함하는 캔들정보 시트 목록을 리턴합니다.
※ (수정 후 'sheets_cs' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function sheets_cs(sn) As String
If Not sn = xlNullString Then
For Each sh In ActiveWorkbook.sheets
If sh.Name = sn & "-5분" Or sh.Name = sn & "-15분" _
Or sh.Name = sn & "-60분" Or sh.Name = sn & "-일" Then _
sheets_cs = sheets_cs & sh.Name & ","
Next sh
Else
For Each sh In ActiveWorkbook.sheets
If InStr(sh.Name, "-5분") > 1 _
Or InStr(sh.Name, "-15분") > 1 _
Or InStr(sh.Name, "-60분") > 1 _
Or InStr(sh.Name, "-일") > 1 Then _
sheets_cs = sheets_cs & sh.Name & ","
Next sh
End If
If Not (sheets_cs = Empty Or sheets_cs = "") Then _
sheets_cs = Left(sheets_cs, Len(sheets_cs) - 1)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ Input으로 받은 종목명이 Null 스트링인 경우 기존에 생성된 모든 캔들정보 시트 목록을 리턴합니다.
폼을 수정하겠습니다. 폼 'FSchedule'의 다중페이지에 새 페이지를 생성하고 종목 선택을 위한 콤보상자 'ComboBoxSN'을 추가합니다.
 |
| 그림 2-1. 종목 선택을 위한 페이지 작성 1 |
기존의 'Time' 페이지에 존재하는 캔들 시간단위 선택 콤보상자 'ComboBoxCT'를 새로 만든 페이지로 이동합니다.
 |
| 그림 2-2. 종목 선택을 위한 페이지 작성 2 |
'ButtonSCAdd' 이름으로 버튼을 추가하고 Caption을 적절히 입력합니다.
 |
| 그림 2-3. 종목 선택을 위한 페이지 작성 3 |
기존의 페이지 'Stocks'를 삭제하고 새로 만든 페이지의 이름을 적절히 수정합니다.
 |
| 그림 2-4. 종목 선택을 위한 페이지 작성 4 |
폼 'FSchedule'의 초기화 코드를 수정합니다.
※ (수정 후 'UserForm_Initialize' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private s_code As Collection '▶ 전역변수 추가
Private Sub UserForm_Initialize()
ComboBoxTS.AddItem "09:00:00"
ComboBoxTS.AddItem "10:00:00"
ComboBoxTS.AddItem "11:00:00"
ComboBoxTS.AddItem "12:00:00"
ComboBoxTS.AddItem "13:00:00"
ComboBoxTS.AddItem "14:00:00"
ComboBoxTS.AddItem "15:00:00"
ComboBoxTS.Text = "09:00:00"
ComboBoxTE.AddItem "09:00:00"
ComboBoxTE.AddItem "10:00:00"
ComboBoxTE.AddItem "11:00:00"
ComboBoxTE.AddItem "12:00:00"
ComboBoxTE.AddItem "13:00:00"
ComboBoxTE.AddItem "14:00:00"
ComboBoxTE.AddItem "15:00:00"
ComboBoxTE.Text = "15:00:00"
ComboBoxCT.AddItem "5분", 0
ComboBoxCT.AddItem "15분", 1
ComboBoxCT.AddItem "60분", 2
ComboBoxCT.AddItem "일", 3
ComboBoxCT.ListIndex = 0
s_list = getStockList()
Set s_code = New Collection
For i = LBound(s_list, 1) To UBound(s_list, 1)
If s_list(i, 1) <> "" Then
s_code.Add s_list(i, 1), s_list(i, 2)
ComboBoxSN.AddItem s_list(i, 2), i - 1
End If
Next i
ComboBoxSN.ListIndex = 0
s_list = Split(sheets_cs(xlNullString), ",")
For i = LBound(s_list) To UBound(s_list)
ListBoxSC.AddItem Replace(s_list(i), "-", " ")
Next i
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 's_code' collection은 종목명을 키로 종목코드를 저장하기 위해 사용합니다.
'ButtonSCAdd'의 이벤트 매크로를 작성합니다.
※ ('ButtonSCAdd_Click' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ButtonSCAdd_Click()
ns = ComboBoxSN.Value & " " & ComboBoxCT.Value
For i = 0 To ListBoxSC.ListCount - 1
If InStr(ListBoxSC.List(i), ComboBoxSN.Value) > 0 Then GoTo Skip:
Next i
On Error Resume Next
ListBoxSC.AddItem ns
On Error GoTo 0
Skip:
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 목록상자 'ListBoxSC'에 동일한 종목이 존재하지 않을 경우에만 추가합니다.
☞ 하나의 종목 당 하나의 캔들정보 시트만 생성하도록 제한을 둔 것입니다.
목록상자 'ListBoxSC'의 더블클릭된 항목을 목록상자로부터 제거하도록 이벤트 처리 매크로를 추가합니다.
※ ('ListBoxSC'의 더블클릭 이벤트 매크로 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ListBoxSC_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If Not ListBoxSC.ListIndex < 0 Then _
ListBoxSC.RemoveItem ListBoxSC.ListIndex
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
마지막으로 'FSchedule' 폼의 'OK' 버튼 이벤트 매크로와 이 매크로에 의해 호출되는 'onSchedule' 소스를 수정합니다.
※ ('OK' 버튼 이벤트 매크로 수정)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ButtonOK_Click()
Dim s_list As String 'comma separated selected items list
Me.Hide
For i = 0 To ListBoxSC.ListCount - 1
sitem = ListBoxSC.List(i)
sn = Split(sitem, " ")
sc = s_code.Item(sn(LBound(sn)))
sitem = Replace(sitem, " ", "(" & sc & ")")
s_list = s_list & sitem & ","
Next i
If Len(s_list) > 0 Then
s_list = Left(s_list, Len(s_list) - 1)
Call onSchedule(ComboBoxTS.Text, ComboBoxTE.Text, _
s_list) End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 'onSchedule'로 전달되는 인자의 개수가 변경되었습니다.
※ (수정 후 'onSchedule' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub onSchedule(ts, te, sc) Call registerLinks Call prepareSheet(sc)
If Time > TimeValue(ts) And Time < TimeValue(te) Then
Application.OnTime Now, "Start_Click"
Else
Application.OnTime TimeValue(ts), "Start_Click"
End If
Application.OnTime TimeValue(te), "Stop_Click"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 'prepareSheet'로 전달되는 인자의 개수 또한 변경되었습니다.
▶ 세째 항목, 'prepareSheet', 'storeCandleInfo' 수정
'CCandleFeeder'는 여러 개의 종목에 대해 각각의 상태를 유지하면서 독립적으로 동작하게끔 하려는 목적으로 클래스로 만들었습니다. 그 목적에 맞도록 소스를 수정하겠습니다.
※ (수정 전 'storeCandleInfo' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub storeCandleInfo(s_code)
Static feeders As Collection
'On Error GoTo EH_storeCandleInfo:
If feeders Is Nothing Then Set feeders = New Collection
For i = LBound(ss_list) To UBound(ss_list)
Dim cfeeder As CCandleFeeder
On Error Resume Next
Set cfeeder = feeders.Item(ss_list(i, 1))
If Err.Number = 5 Then GoTo RegisterFeeder:
On Error GoTo 0
If Not cfeeder Is Nothing Then GoTo DoFeed:
On Error GoTo EH_storeCandleInfo:
RegisterFeeder:
Set cfeeder = New CCandleFeeder
cfeeder.StockCode = ss_list(i, 1)
cfeeder.CandleSheet = ss_list(i, 2)
cfeeder.DDEsheet = dde_sheet
cfeeder.CHTsheet = CHART_POSTFIX
feeders.Add cfeeder, ss_list(i, 1)
DoFeed:
cfeeder.store (s_code)
NextLoop:
Next i
Exit Sub
EH_storeCandleInfo:
If Err.Number = 8901 Then
Debug.Print "Error(8901) " & Err.Source
Err.Clear
GoTo NextLoop:
End If
MsgBox "Error(" & Err.Number & ") " & Err.Description & " [storeCandleInfo]"
Err.Raise Err.Number, "storeCandleInfo", Err.Description
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 기존 소스는 'storeCandleInfo'가 호출될 때마다 불필요한 loop를 돌면서 이미 할당되었을 'CCandleFeeder'를 다시 할당하려고 했습니다.
☞ 이 작업을 'prepareSheet'에서 단 한 번만 수행되도록 수정합니다.
※ (수정 후 'prepareSheet' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private feeders As Collection '▶ 전역변수 추가, collection of CCandleFeeders
Function prepareSheet(slist)
Dim xlSheet As Worksheet
Dim s_arr As Variant
On Error GoTo EH_prepareSheet:
dde_sheet = ActiveSheet.Name
s_arr = Split(slist, ",")
s_cnt = UBound(s_arr) - LBound(s_arr) + 1
ReDim ss_list(1 To s_cnt, 1 To 2)
Set feeders = New Collection
For i = LBound(s_arr) To UBound(s_arr)
sn = s_arr(i)
pospl = InStr(sn, "(")
pospr = InStr(sn, ")")
cu = Right(sn, Len(sn) - pospr)
s_code = Mid(sn, pospl + 1, pospr - pospl - 1)
If s_code = Empty Or s_code = "" Then GoTo NextLoop:
sh_name = Left(sn, pospl - 1)
If sh_name = Empty Or sh_name = "" Then sh_name = s_code
sh_name = sh_name & "-" & cu
ss_list(i - LBound(s_arr) + 1, 1) = s_code
ss_list(i - LBound(s_arr) + 1, 2) = sh_name
Dim cfeeder As CCandleFeeder
Set cfeeder = New CCandleFeeder
cfeeder.StockCode = s_code
cfeeder.CandleSheet = sh_name
cfeeder.DDEsheet = dde_sheet
cfeeder.CHTsheet = CHART_POSTFIX
feeders.Add cfeeder, s_code
If Not sheetExist(sh_name) Then
Set xlSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
xlSheet.Name = sh_name
With xlSheet
.Cells(1, 1).value = "일자 / 시간"
.Cells(1, 2).value = "시가"
.Cells(1, 3).value = "고가"
.Cells(1, 4).value = "저가"
.Cells(1, 5).value = "종가"
.Cells(1, 6).value = "거래량"
End With
End If
NextLoop:
Next i
Set xlSheet = Nothing
Exit Function
EH_prepareSheet:
MsgBox "Error(" & Err.Number & ") " & Err.Description & " [prepareSheet]"
Err.Raise Err.Number, "prepareSheet", Err.Description
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 'FSchedule' 폼이 수정되면서 'onSchedule'을 거쳐 전달되는 인자의 개수가 달라졌습니다.
※ (수정 후 'storeCandleInfo' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub storeCandleInfo(s_code)
Dim cfeeder As CCandleFeeder
On Error GoTo EH_storeCandleInfo:
On Error Resume Next
Set cfeeder = feeders.Item(s_code)
If Err.Number = 5 Then Exit Sub
On Error GoTo 0
If Not cfeeder Is Nothing Then cfeeder.store (s_code)
Exit Sub
EH_storeCandleInfo:
MsgBox "Error(" & Err.Number & ") " & Err.Description & " [storeCandleInfo]"
Err.Raise Err.Number, "storeCandleInfo", Err.Description
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
☞ 'storeCandleInfo'는 해당 종목의 'CCandleFeeder'가 할당되어 있을 경우에만 작동하도록 수정되었습니다.
▶ 네째 항목, 'onChartChange' 수정
'onChartChange' sub모듈이 차트에 출력되는 종목을 전환하는 과정에서 화면이 빠르게 변하는 모습을 감추도록 수정합니다.
※ (수정 후 'onChartChange' 소스)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub onChartChange(ParamArray varArgs() As Variant)
If UBound(varArgs) < 3 Then _
Err.Raise 8902, "onChartChange", "ParamArray too short"
Dim chtRng As String, sn As String
On Error GoTo EH_onChartChange:
Application.ScreenUpdating = False
sn = Cells(2, 2).Value
If UBound(varArgs) > 3 Then sn = varArgs(4)
If sn = xlNullString Then Exit Sub
csheet = ActiveSheet.Name
chtRng = fillChartRng(csheet & "_AUX", sn, False, 2, varArgs(3))
Sheets(csheet).Select
endRow = Sheets(sn).Cells(1, 1).End(xlDown).Row
If ActiveSheet.ChartObjects.Count = 0 Then
drawChartTWH Sheets(csheet & "_AUX").Range(chtRng), _
varArgs(0), varArgs(1), varArgs(2), csheet, _
csheet & "_AUX" & "!" & Cells(1, 1).Address, _
WorksheetFunction.Max(endRow - varArgs(3) - 1, 0), _
sn
Else
Dim ch As ChartObject, sbar As ScrollBar
Set ch = Sheets(csheet).ChartObjects(1)
ch.Chart.SetSourceData Source:=Sheets(csheet & "_AUX").Range(chtRng)
ch.Name = sn
Set sbar = Sheets(csheet).ScrollBars(1)
sbar.Max = WorksheetFunction.Max(endRow - varArgs(3) - 1, 0)
sbar.Value = WorksheetFunction.Max(endRow - varArgs(3) - 1, 0)
End If
Application.ScreenUpdating = True
Exit Sub
EH_onChartChange:
MsgBox "Error(" & Err.Number & ") " & Err.Description & " [onChartChange]"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
※ 수정사항을 반영한 엑셀 파일(엑셀 2007에서 작성)입니다. ☞
댓글 없음:
댓글 쓰기