目標100倍!!

目標100倍! でも退場寸前!! ミニがだめならFX??

横着者のVBA

[ リスト | 詳細 ]

記事検索
検索

全4ページ

[1] [2] [3] [4]

[ 次のページ ]

外部プログラムの起動・終了

はっちゅう君を VBAから起動・終了するのに SendKeysを使っていたら不安定だとブログに書いたら、まひろさんから Windows APIを使うとよいとコメントをいただきました。そこで、よくわからないまま、ネットを探ってとりあえず動くようになりました。ありがとうございました! 正しいかどうかはよくわかりませんが、とりあえず載せておきます。もちろん、はっちゅう君でなくても使えます。
はっちゅう君起動後、アドインの起動は F5に割り当てているので、F5を押しています。アドインが起動すると、アドインプログラムがログインや取引暗証番号設定などを自動でしてくれます。

Option Compare Database
Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_CLOSE = &H10
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_COMMAND As Long = &H111
Private Const VK_F5 = &H74
Private Const CLASSNAME_ダイアログ As String = "#32770"
Private Const CLASSNAME_ボタン As String = "Button"

Sub はっちゅう君の起動()
Dim WinHnd As Long
Const Process = "はっちゅう君＋"

If FindWindow(vbNullString, Process) = 0 Then
Shell ("C:\Program Files\CLICK-SEC\HatchukunPlus\HatchukunPlus.exe"), 1
' はっちゅう君のウィンドウハンドルを取得
WinHnd = FindWindow(vbNullString, Process)
Do While WinHnd = 0
DoEvents
WinHnd = FindWindow(vbNullString, Process)
Loop

' アドイン起動を F5 に割り当てているので F5 を送信
Dim response As Long
response = PostMessage(WinHnd, WM_KEYDOWN, VK_F5, 0)
' なくても良いかも？
response = PostMessage(WinHnd, WM_KEYUP, VK_F5, 0)
End Sub

' ログインしているとポップアップウィンドウが出て確認を求められる。
' 以下は、ログインしているのが前提です。
Sub はっちゅう君の終了()
Const Process = "はっちゅう君＋"
Dim WinHnd_はっちゅう君 As Long
Dim WinHnd_終了確認ダイアログ As Long
Dim response As Long
Const ログアウト確認ダイアログ As String = "ログアウト"

WinHnd_はっちゅう君 = FindWindow(vbNullString, Process)
If WinHnd_はっちゅう君 <> 0 Then
' 終了コードを送信
response = PostMessage(WinHnd_はっちゅう君, WM_CLOSE, 0, 0)
' 終了確認ダイアログが出るまで待ち、そのウィンドウハンドルを取得する
If Not FindDialog(ログアウト確認ダイアログ, WinHnd_終了確認ダイアログ) Then
Exit Sub
End If
' 終了確認ダイアログの「はい」ボタンを押す
Call PushButton(WinHnd_終了確認ダイアログ)
End If
End Sub

'ダイアログを探す
Private Function FindDialog(ByVal p_strCaption As String, ByRef p_lngFindWnd As Long) As Boolean
Dim start As Date
Const PauseTime As Integer = 10
p_lngFindWnd = 0
Do
DoEvents
If Timer < start + PauseTime Then Exit Do
p_lngFindWnd = FindWindow(CLASSNAME_ダイアログ, p_strCaption)
Loop While p_lngFindWnd = 0

FindDialog = p_lngFindWnd <> 0
End Function

'ボタンを押す
Private Sub PushButton(ByVal p_lngWindowWnd As Long, Optional p_strBtnCaption As String = "はい(&Y)")
Dim l_lngWnd As Long
l_lngWnd = FindWindowEx(p_lngWindowWnd, 0, CLASSNAME_ボタン, p_strBtnCaption)
Call SendMessage(p_lngWindowWnd, WM_COMMAND, GetDlgCtrlID(l_lngWnd), ByVal l_lngWnd)
End Sub

開く トラックバック（0）

パソコンの遠隔操作

5分足トレード用にトレイダーズ証券のトレードスタジアムを昼夜分かたず走らせています。平日にトレスタが止まることはないのですが、日曜日とかにメンテのせいで切断されてしまうようです。月曜日に関西から出先へ直接お出かけすることがあると、再接続ができません。そこで、Windows用リモートコントロールソフトUltraVNC 1.0.4RC14 日本語版 Release 1を導入しました。コントロールしたいパソコンの画面が表示され、画面を見ながら操作できます。ファイルの交換も可能です。その他、相手がいればチャットもできるようです。スピードがメチャ遅い PHS経由で接続してもちゃんと使えます。なお、この方法はパソコンをインターネットにさらしているので、PWはかなり複雑なものを設定することをお勧めします。

簡単に設定方法を書いておきます。UltraVNCの詳細はネット検索で!

【 サーバー側 (コントロールされる側)】
(1) UltraVNC をインストールする
　サーバー管理画面で自分用にPWを設定すること
　XPの時はAeroを解除をOffにする
　自動でWindows の Firewallも例外設定される
(2) パソコンのIPアドレスを固定する。
例: IPアドレス 192.168.0.10
　　サブネットマスク 255.255.255.0
　　DNS 192.168.0.1
(3) ブロードバンドルータのポートマッピング設定でNATエントリーを設定する。
例: エントリ番号: 1
　　変換対象プロトコル: TCP
　　変換対象ポート: 5900 (UltraVNCが標準設定の場合。)
　　宛先アドレス: 192.168.0.10 (パソコンに設定したIPアドレス)

もし2台つなぎたいとき、
(1') UltraVNCの管理画面で、ポートを手動でたとえば5901、5801に設定する。
　WindowsのFirewallを手動で5900→5901、5800→5801へ設定を修正する
(2') パソコンのIPアドレスを固定する。
例: IPアドレス 192.168.0.11
　　サブネットマスク 255.255.255.0
　　DNS 192.168.0.1
(3') ブロードバンドルータのポートマッピング設定でNATエントリーを設定する。
例: エントリ番号: 2 (←最初の投稿時、間違えていました)
　　変換対象プロトコル: TCP
　　変換対象ポート: 5901 (UltraVNCの設定した値。)
　　宛先アドレス: 192.168.0.11 (パソコンに設定したIPアドレス)

(4) ルータのグローバルIPアドレスを確認する。
例: IPアドレスチェック
　　(IPアドレスはルータをリセットしなければ変わらないが、
　　 プロダイバによりアクセスがないと変わることもある。)

【 クライアント側 (コントロールする側)】
(1) UltraVNCビューアを起動する。
(2) ルータのグローバルIPアドレスをVNCサーバ欄に入力して接続を押す。
例: 123.456.789.012:5900 (123.456.789.012でも可)
2台目のパソコンを操作したいとき
(2') 123.456.789.012:5901
(3) PWを入力すればOK

開く トラックバック（0）

お任せプログラムの概要

お任せプログラムの概要を紹介します。

ハード: Pentium III 700MHz、XP SP2 のノートパソコンで運用しています。引出しの中で、こっそり動いています。

ソフトウェア: Access 2003 のみです。Access はデータベースですから、データの抽出が容易で、たとえ件数が一千万を超えても、あまり気にすることはありません。起動したまま何日でもほったらかすことが可能です (エラーが無くなれば!!)。

証券会社: GMO インターネット証券を使っています。プログラム取引用のツールが公開されているので、VBA などから直接発注等が可能です。発注等は「横着者のVBA」で使っている MSHTTP で、売買条件を並べた URI を Send するだけで、超簡単、超早です。ただ、ひどいことに、GMO 証券は現在値の参照機能を提供していません。
　ご参考: http://sky.geocities.jp/mujintrading/

やっていること: 「寄り引け」は、当日の始値を基準に定めた「利確値」、「止めとけ値」、「損切り値」と現在値を比較し、それに合わせて返済注文をしているだけです。たとえば、売るか買うかを決めるルーチンに従い寄り前に買い発注したら、値付き後に約定をチェックし、とりあえず利益を狙った利確値で指値返済発注をします。後、値動きに従い、やや下がってきて止めとけ値に触れたら仕込み値付近の撤退値に指値を変更、損切り値になったら損切り値 -500 円で指値発注します。寄り引け建て玉が約定せず残っており、引け寄りの向きと同じなら引け寄りに引き継ぎます。「場中参加」はこれに「出動値」が増え、出動値に触れれば成り発注します。あとは同じです。株では急騰時等に利確値を自動で吊り上げるというのが有効かと思い以前使っていましたが、先物では動いたといっても変化率は小さいし行きつ戻りつが多いので効果はいまいちかと思い、固定値です。それぞれの値は 1分足の解析で決めています。「引け寄り」は単純に計算結果に基づいて売り買いしているだけで、お手軽です。

現在値の取得: Access のフォームに WebBrowser を配置 (Access の中でインターネットエクスプローラー IE を動かすようなもの) して、証券会社のホームページから「横着者のVBA」で紹介した方法でデータを抽出しています (実は、証券会社のホームページに MSHTTP でログインする方法がわかりません)。Access のフォームにはタイマー機能があるので、6 秒ごとに WebBrowser を更新してチェックしています (よって Form_Timer がメインルーチンです)。間隔はもっと縮められますが、これで十分だと思います。外部 IE を使っても同じことができますが、Access がエラーで止まっときオブジェクトが残ってしまいます。楽天 RSS に DDE でつなぐというのも手ですが、高度のプログラミングテクニック (私には無理)とか、ネットが途切れたときなど MarketSpeed 等に再度ログインしないといけないとか、余計な心配や手続きが必要になります。
　ご参考: http://www2s.biglobe.ne.jp/~katsum/marketspeed/
　　　　　http://plaza.rakuten.co.jp/acknight/diary/200711020001/

開く トラックバック（0）

2-5. ホームページからファイルをダウンロードする(2)

昨日の続きです。
横着するための Access 用プログラムです。昨日のダミーと置き換えてください。
Excel とAccess では数値の管理が違うらしく、小数の非常に小さなところで微妙な差が出ます。日付も小数なので、リンクした Excel シート内を分単位で時間の検索してもうまくマッチしない時刻がいくつか出てしまいます。少しごまかして比較しなければなりません。分足を保存する Access テーブルの名前は私が使っているものとなっています。適当に変更してください。また、テーブルが空のときやワークシートが変わったときは、1日分を手でコピペしないといけませんが、年に2回のために考えるのは面倒なので自動化していません。

' Excel では動きません
Function 分足データの取得(SourceExcel As String, TypeIndex As Integer)
' Excel ファイルを Access のリンクテーブルとし、新規データのみを抽出する
' 分足ファイルが全く空だとエラーが出ます。あらかじめ 1 日分は手でコピーしてください。
Dim 分足ファイル As String
' 分足を保存する Access テーブル (フィールド: 日付, 時間, 始値, 高値, 安値, 終値, 出来高)
Select Case TypeIndex
Case Index_N225先物large_1min
分足ファイル = "N225先物_1分" ' 適当に
Case Index_N225先物mini_1min
分足ファイル = "N225先物mini_1分"
End Select
Dim rst As Recordset
Dim 更新前日付 As Date, 更新前時間 As Date, 更新後日付 As Date, 更新後時間 As Date
Set rst = CurrentDb.OpenRecordset(分足ファイル)
更新前日付 = DMax("日付", 分足ファイル)
更新前時間 = DMax("時間", 分足ファイル, "日付=#" & 更新前日付 & "#")

Dim ExcelLink As String
ExcelLink = "n1" ' 何でも良い
Dim tblLinked As TableDef
Dim LinkSourcePath As String, LinkDatabase As String
Set tblLinked = CurrentDb.CreateTableDef(ExcelLink)
' おまじないの言葉は、試しにリンクしてその値を読んで調べる
tblLinked.Connect = "Excel 8.0;HDR=NO;IMEX=2;DATABASE=" & SourceExcel
' ワークシートが変わったとき、新シートの 1 日分は手でコピーしてください。
tblLinked.SourceTableName = "'1分��$'" ' リンクするワークシート名
CurrentDb.TableDefs.Append tblLinked

Dim qdf As QueryDef
Set qdf = CurrentDb.CreateQueryDef("", "select * from " & ExcelLink & " where F7>=0")
Set rst = qdf.OpenRecordset
' Excel と Access で日付の処理が微妙に違うようで、素直に探せない
rst.FindFirst "F1=#" & 更新前日付 & "# and hour(F2)=" & Hour(更新前時間)
Dim strSQL As String

If Not rst.NoMatch Then
strSQL = "INSERT INTO " & 分足ファイル & " ( 日付, 時間, 始値, 高値, 安値, 終値, 出来高 )" _
& " select F1,F2,F3,F4,F5,F6,F7 from (select * from " & ExcelLink & " where F7>=0)" _
& " where (F1=#" & 更新前日付 & "# and F2>#" & 更新前時間 & "#) or F1>#" & 更新前日付 & "#"
Set qdf = CurrentDb.CreateQueryDef("", strSQL)
qdf.Execute
End If
CurrentDb.TableDefs.Delete ExcelLink
更新後日付 = DMax("日付", 分足ファイル)
更新後時間 = DMax("時間", 分足ファイル, "日付=#" & 更新後日付 & "#")
If 更新前日付 <> 更新後日付 Or 更新前時間 <> 更新後時間 Then
分足データの取得 = IIf(TypeIndex = Index_N225先物large_1min, "日経先物", "日経先物ミニ") _
& "の1分足データは" & 更新後日付 & " " & 更新後時間 & " まで取得しました。"
Else
分足データの取得 = IIf(TypeIndex = Index_N225先物large_1min, "日経先物", "日経先物ミニ") _
& "の新しいデータはありませんでした。"
End If
End Function

開く トラックバック（0）

2-5. ホームページからファイルをダウンロードする(1)

今日は、ホームページからファイルや写真などをダウンロードしましょう。MSHTTP を使うところは同じですが、保存するために、Stream オブジェクトを使うと良いようです。
私はいつも日経先物データを「汲めども尽きない無尽蔵」からちょうだいしています。でもファイルを解凍したり、増えた部分を選んでコピーしたりするのが面倒でした。それを横着するためのプログラムです。
例は、宣言セクションも含めて新しい標準モジュールにコピペしてください。また、解凍に使う UNLHA32.DLL をパソコンにインストールしておいてください。
Excel の場合はダウンロードし、解凍したファイルを保存するだけです。Access だと自動で新しく増えた 1分足データをテーブルに追加します。事前にデータを保存するテーブル (フィールド: 日付, 時間, 始値, 高値, 安値, 終値, 出来高)を作成してください。ただし、年に 2 回は手動コピーが必要になります。
なお、例をそのまま走らせると、保存フォルダ設定のところでエラーが出ます。エラーの出た行をコメント行にしてください。また、相手先の都合でファイル名やパス等が変更されることがあります。
字数制限のため、「Function 分足データの取得()」の中身はまた明日。

Option Explicit
Const Index_N225先物large_1min = 1, Index_N225先物mini_1min = 2

' UNLHA32.DLL は事前にパソコンにインストールしてください
' 作者: http://www2.nsknet.or.jp/~micco/mysoft/unlha32.htm
' 窓の杜: http://www.forest.impress.co.jp/lib/arc/archive/arcdll/unlha32.html
' UNLHA32 API 定義
Public Declare Function Unlha Lib "unlha32" (ByVal hWindows As Long _
, ByVal CmdLine As String, ByVal Console As String, ByVal size As Long) As Long

Sub 日経先物分足データの取得()
Dim URI As String
Dim 保存フォルダ As String
Dim Filename As String
Dim SourceExcel As String
Dim response As String

' ダウンロードしたいファイルのあるホームページの URI
' ここでは「汲めども尽きない無尽蔵」
URI = "http://souba-data.com/data/" & Year(Date) & "/"
' Access の例、この Access ファイルのあるフォルダ
保存フォルダ = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))
' Excel の例、最後に \ 印をつけること
保存フォルダ = ActiveWorkbook.Path & "\"

' ダウンロードするファイルの名前
Filename = Year(Date) & "_225.lzh" ' ミニ: Year(Date) & "_mini.lzh"
ファイルをダウンロードし保存 URI, Filename, 保存フォルダ
If LHA解凍(保存フォルダ & Filename, 保存フォルダ, "*.*") Then
' 解凍して生成されるファイルの名前
SourceExcel = Year(Date) & "_225.xls" ' ミニ: Year(Date) & "_mini.xls"

' ダウンロードした圧縮ファイルは削除
Kill 保存フォルダ & Filename

' *** Excel では動きません ***
If Application.Name = "Microsoft Access" Then
' ファイルから必要な情報を取り出し、Access に取り込む
' ミニ: Index_N225先物large_1min → Index_N225先物mini_1min
response = 分足データの取得(保存フォルダ & SourceExcel, Index_N225先物large_1min)
' 解凍生成したファイルを削除
Kill 保存フォルダ & SourceExcel
End If

Debug.Print "情報収集完了: "; SourceExcel
Else
Debug.Print "解凍失敗: "; SourceExcel
End If
End Sub

Function ファイルをダウンロードし保存(URI As String, Filename As String, 保存フォルダ As String)
Dim objHttp As Object
Set objHttp = CreateObject("MSXML2.XMLHTTP")
objHttp.Open "GET", URI & Filename, False
objHttp.send

' stream object用 の定数
Const adTypeBinary = 1
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
Dim stream As Object
Set stream = CreateObject("Adodb.Stream")
With stream
.Type = adTypeBinary
.Open
.write objHttp.responseBody
.SaveToFile 保存フォルダ & Filename, adSaveCreateOverWrite
.Close
End With
Set stream = Nothing
Set objHttp = Nothing
End Function

Public Function LHA解凍(対象ファイル As String, 解凍先パス As String, 解凍ファイル As String) As Boolean
Dim hwd As Variant
Dim response As Long
Dim cons As String

Dim パラメーター As String
' パラメーターの詳細は UNHLA32 の添付文書をお読みください
パラメーター = "e -y " & 対象ファイル & " " & 解凍先パス & " " & 解凍ファイル

cons = Space(256)
response = Unlha(hwd, パラメーター, cons, LenB(cons))
If response = 0 Then
LHA解凍 = True ' 正常終了
Else
LHA解凍 = False ' 異常終了
End If
End Function


' Excel では動きません
Function 分足データの取得(SourceExcel As String, TypeIndex As Integer)
End Sub

開く トラックバック（0）

全4ページ

[1] [2] [3] [4]

[ 次のページ ]

Yahoo!ブログからのお知らせ

.
ふ〜ちゃん
ふ〜ちゃん
男性 / O型
人気度
Yahoo!ブログヘルプ - ブログ人気度について

ブログバナー

日 月 火 水 木 金 土
1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30

最新のコメント

最新のトラックバック

Yahoo!からのお知らせ

友だち(3)
  • ウルフオルフェノク
  • uio*92
  • 夏美
友だち一覧

[PR]お得情報

数量限定！イオンおまとめ企画
「無料お試しクーポン」か
「値引きクーポン」が必ず当たる！
ふるさと納税サイト『さとふる』
実質2000円で特産品がお手元に
11／30までキャンペーン実施中！

その他のキャンペーン

プライバシー -  利用規約 -  メディアステートメント -  ガイドライン -  順守事項 -  ご意見・ご要望 -  ヘルプ・お問い合わせ

Copyright (C) 2019 Yahoo Japan Corporation. All Rights Reserved.

みんなの更新記事
前へ 次へ