三流君 ＶＢＡで楽しくプログラミング(Excel/Access VBAの解説/サンプルです)
[VBA系のバックナンバー]
[VBA系 TOP]
[三流君 TOP]
＜VBAからIE操作 .document.forms(0).Submit でフォーム送信処理＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
VBAからIE操作
で、
フォームの送信処理をやってみます。
たいした解説、回答内容じゃないのですが。
/*
* １．今回のキッカケ
*/
メールで下記の質問をもらいました。
----
>それで、また質問なのですが、上記の環境と変わって、今はデータがPDF
>ではなくHTMLからCSVで取得できます。そのさい、Accessから IE にHTML上の、
>INPUUT窓に入力コードとEnterをSendkeys で送りますが、{Enter}がダメで、結
>局マウスで実行ボタンをクリックしています。
>
>これは、ActiveX上でのことで、通常のIE上では、入力、Enterが効きます。
>なにか、復壊コードとOSの関係かと思いますが、よろしくお願いします。
>
>マシン環境は、WINME アクセス2000 IE6.0 です。
----
う〜ん、Enterが送られないのかぁ。
で、
通常のIE上はＯＫ、フォームに設置したActiveXコントロールは不可ってことか・・
/*
* ２．調べごと、下準備
*/
やりたいことは、ＨＴＭＬフォームにデータセットと送信ボタンクリックなので、
手前味噌的な紹介だと、
No.97 InternetExplorer.application操作 .Clickでクリック
http://www.ken3.org/backno/backno_vba20.html#97
で、
http://www.ken3.org/cgi-bin/test/test068.html
の下記のＨＴＭＬに対して、
<center>
<h2>けんぞうのへんてこな世界へようこそ</h2>
<br>
<table bolder=1>
<FORM ACTION="test068-1.asp" METHOD="POST">
USER ID:<INPUT TYPE="text" NAME="userid" SIZE="12"><br>
パスワード:<INPUT TYPE="password" NAME="pass" SIZE="12"><br>
<INPUT TYPE="submit" NAME="btn01" VALUE="ログイン">
<INPUT TYPE="reset" VALUE="クリア">
</FORM>
</table><br>
<a Href="test068-2.asp" TARGET="_top">新規ユーザー登録</a><br>
</center>
データをセットして、送信ボタンを押してみました。
Sub ie_test_click()
Dim objIE As Object 'ＩＥオブジェクト参照用
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
'文字列で指定したＵＲＬに飛ぶ
objIE.Navigate "http://www.ken3.org/cgi-bin/test/test068.html"
'表示終了まで待つ
Do While objIE.Busy = True
'何もしないループ（笑）
DoEvents
Loop
'項目名を指定して、データをセットする
objIE.document.all.userid.Value = "Ken3" 'ユーザー名
objIE.document.all.pass.Value = "aaa" 'パスワード
'データせっとできたので、
'ボタンを押してみる
objIE.document.all.btn01.Click 'クリックメソッドを実行
End Sub |
こんな、短いプログラムで、自動ログイン処理が可能です。
※なんとなく、オールスターの自動投票処理も簡単に出来るかもしれませんね。
なんて、ほざいてましたが、
ここで、１つ問題があります。
<INPUT TYPE="submit" NAME="btn01" VALUE="ログイン">
<INPUT TYPE="reset" VALUE="クリア">
SUMMITのボタンに、私は名前を付けましたが、
<INPUT TYPE="submit" VALUE="ログイン">
なんて感じで、名前は付けなくてもいいんですね。
なので、
'ボタンを押してみる
objIE.document.all.btn01.Click 'クリックメソッドを実行
が、使えないフォームがあるんですよ。。。
※名前が付いてないのでxxxx.Clickが出来ない。
そんなのHTML作っているヒトに、名前付けてもらえばいいじゃん？
名前付けるなんてスグでしょ？
オイオイ、待ってよ・・・
私、違法投票のプログラム作ってます、私が自動にクリックしたいので、
フォームのボタンに何か名前を付けてください
よろしくお願いします・・なんて言えないでしょ。
自分でＨＴＭＬ側も作っていれば別だけど、
今ある物を、外部からＩＥ通して操作するんだから、
自分の都合のよいように作ってくれないよ。
※また、相手先の突然のレイアウト変更とかあったりして、
ハマるケースもありかなぁ。
/*
* ３．IEオブジェクトを探り、Formsを発見
*/
さてと、どうしましょうかねぇ。
問題は、Enterキーだけなので、フォームをクリックできればなぁ。
また、久々に得体の知れないIEお嬢様のオブジェクトを探るか、、、
ウオッチ式を入れてと、
おっ、Formsってそれらしいのがあるよね。
これ使えそうですね。
↑オブジェクトの中から、Formsを発見。
探り方の詳細は、
[No.52 InternetExplorer.application .document.body.innerText]
( http://www.ken3.org/backno/backno_vba11.html#52 を参照)
で、彼女（オブジェクト）の中身を探る方法を少し書いてます。
よし、さっそくテストしてみるか。
'フォームをクリックする？
objIE.document.forms(0).Click
と入れて実行。
オイオイ、何も起こんないよ、
ホントに動作してるのか？
これって、フォームをクリックしてるんじゃない？
ボタンならクリックでいいけど、
フォームは、submit でしょ？
そっか、では、テストで、
'フォームをSubmitする？
objIE.document.forms(0).Submit
でどうだ・・・
おっ、ログインできた。
objIE.document.forms(0).Submit
.forms(0)と、頭のフォームと番号で指定しているのが、
情けないけど、このフォームに対して、
.Submitでリターンキーを押した結果が得られます。
objIE.document.forms(0).Submit
IEオブジェクトのドキュメントの０番目のフォームをＳＵＢＭＩＴって感じかなぁ。
最後に１行書いただけですが、フォームのSUBMITテストです。
いろいろと自分の環境に合わせて、テストしてみてください。
Sub ie_test()
Dim objIE As Object 'ＩＥオブジェクト参照用
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
'文字列で指定したＵＲＬに飛ぶ
objIE.Navigate "http://www.ken3.org/cgi-bin/test/test068.html"
'表示終了まで待つ
Do While objIE.Busy = True
'何もしないループ（笑）
DoEvents
Loop
'項目名を指定して、データをセットする
objIE.document.all.userid.Value = "Ken3" 'ユーザー名
objIE.document.all.pass.Value = "aaa" 'パスワード
'フォームをSubmitする
objIE.document.forms(0).Submit
End Sub |
あっ、質問は、Accessのフォーム上に配置した
ActiveXコントロールだった。
処理同じだけど
WebBrowser0
って名前で、Web Browser コントロールを挿入。
コマンドボタンが押されたら、
Private Sub コマンド1_Click()
Me!WebBrowser0.Visible = True '見えるようにする(お約束)
'文字列で指定したＵＲＬに飛ぶ
Me!WebBrowser0.Navigate "http://www.ken3.org/cgi-bin/test/test068.html"
'表示終了まで待つ
Do While Me!WebBrowser0.Busy = True
'何もしないループ（笑）
DoEvents
Loop
'項目名を指定して、データをセットする
Me!WebBrowser0.Document.all.userid.Value = "Ken3" 'ユーザー名
Me!WebBrowser0.Document.all.pass.Value = "aaa" 'パスワード
'フォームをSubmitする
Me!WebBrowser0.Document.Forms(0).Submit
End Sub |
単に、objIEがMe!WebBrowser0になっただけ
と
CreateObjectがなくなった（フォームにあらかじめ配置しているので）
そんな感じでした。
↑Accessフォーム上でのテスト実行結果
-【けんぞう！】---------------------------------------------------------
三流君の、小金稼ぎ、お小遣い稼ぎシリーズ第３弾（稼げないだろコラ！！）
参加無料：予想が当たれば一攫千金？今月はプロ野球のセパ勝敗とホームラン数
http://www.ken3.org/etc/500yen/5050.html ← 100万を当たった人数で山分け
『チッ、大穴横浜の勝利に賭けてるのに当たらない（笑）』（横浜ファン：31歳）
------------------------------------------------------------------------
/*
* ４．終わりの挨拶
*/
今回は、
IE操作、フォームの送信処理で、
objIE.document.forms(0).Submit
と、
ドキュメント内のフォームオブジェクトに対して、
.Submit してみました。
IEお嬢様は、ナンパの攻略本が少ないから（資料が少ないから）
なかなか、攻略するの大変そうです。
困ったときのキーを送っちゃえ、ＳｅｎｄＫｅｙｓ攻撃が効かないと特に。
私最近は町にナンパしに行く元気ないので、調べてないです。
でも、皆さんが攻略できなかった、
あの子手ごわいよなんて話を聞くと、落としてみたくなったりして。
※まわりくどいんだよ、気軽に質問ください、
IE操作、気になったら一緒に調べますよでいいじゃん（笑）
ですね。町でナンパしたことないのに、
ナンパ師チャラ君達の心境をマネてもボロ出ちゃうよね。
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
関連項目(ただのバックナンバー紹介)
インターネットエクスプローラーの操作
http://www.ken3.org/cgi-bin/group/vba_ie.asp
で、下記のリンクまとめてます。
No.50 IE起動 CreateObject("InternetExplorer.application")
No.52 InternetExplorer.application .document.body.innerText
No.53 文字列を探す、InStr関数の使い方
No.70 InternetExplorer.application .document.all(0).innerHTML
No.71 IE操作 リンク先を取出す .Document.links(i).href
も参考にしてください。
＜Access サブフォームで連結 重複を弾いてメインに表示＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
読者よりもらった質問をまたまた、処理してみたいと思います。
※２週間以上前にもらった質問だった、、、
なかなかいい処理が思いつかなくて。
じゃ、いい処理思いついたのかよ！といわれると、ドロドロした逃げ手なんだけど。
いつものように、たいした解説、回答内容じゃないので、
暇つぶしに休み時間などに拾い読みしてください。
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba106.lzh
にdb106.mdb(Access2000版)が保存されています。
/*
* １．今回のキッカケ
*/
メールで下記の質問をもらいました。
----
>例としまして（本当はもっとドロドロしたデータベースなんですが、
> 違う例えで書いてみました。）
>
>親フォームが音楽のバンド名が記載されてます。
>サブフォームには、
>そのバンドのメンバーと出身県と楽器と年齢などが記載されています。
>
>そこで、親フォームには、そのバンドのメンバーの出身県が出るテキスト
>ボックスがあります。
>
>例えば・・・バンド名（BOOWY）−−−−−−−−−−親フォーム
> メンバー（氷室、布袋、松井、高橋）−−サブフォーム
> 出身県（群馬、群馬、群馬、福島）−−−サブフォーム
>
>●質問１
>
>で、このサブフォームに記載されている、出身県を親のフォームの
>任意に作成したテキストボックスの中に「群馬、福島」とだけ表示したいのです。
>
>「群馬、群馬、群馬、福島」と表示するのは、ちょっと・・・。
>群馬がだぶっているので、群馬の表示は１つとしたいのです。
>
>
>●質問２
>
>また、沢山のバンドや歌手をこのデータベースに入力します。
>そこで、「布袋」と検索すると、親フォームの「BOOWY」が表示されるようにしたい
>のです。
>
>まず親フォームのバンド名には
>「バンドID」と云う名のフィールド名の主キー（オートナンバー）がありまして
>
>それをサブフォームの中にもフィールド名で、 同じ「バンドID」という
>固有のデータで繋がっているです。
>
>こんな説明で分かってもらえるんでしょうか・・・。
>すごく不安です。
-----
２つの親子テーブルが存在して、
バンドIDでつなげた、フォーム・サブフォームが存在する。
まずは、
親フォームにある、
そのバンドのメンバーの出身県が出るテキストボックスに表示する。
これを処理してみたいと思います。
/*
* ２．調べごと、下準備
*/
親テーブル名:T_バンド名
バンドID オートナンバー
バンド名称 テキスト
備考 メモ型
子テーブル名：T_メンバー
個人ID オートナンバー
バンドID 長整数型（親テーブルとリンクする）
名前 文字型
楽器 文字型
出身地 文字型
生年月日 日付型 *今回関係ないけど
備考 文字型 *今回関係ないけど
なんて、テーブル構成にして、フォームを作成しました。
ポイントは
^^^^^^^^^^^
普通に、子テーブルを表形式、親を単票で作成して、
親フォームのデザインで、サブフォーム・サブレポートのコントロールを選択します。
既存のフォーム（作成した子フォームを選択します）
リンクするフィールドを選択します
（名称が同じフィールドが自動で設定されると思います）
サブフォームの名前を決めて、終了です。
あとは、親フォームにtxt出身地と非連結のテキストボックスを作成します。
（※データセット、連結はこれから作ります）
さて、なんとか、ここまでは、簡単に作れました。
が、配置気にしない（笑）テスト用のイメージです
/*
* ３．テーブルからデータを読み込んでみる
*/
ほしいのは、バンド別の出身地（重複無し）なのですが、
とっかかりは、
子テーブルをバンドIDを条件にして、
出身地を読み込みます。
Private Sub コマンド14_Click()
Dim str出身地 As String '出身地の管理
Dim rs As New ADODB.Recordset 'ADOのレコードセット
Dim strSQL As String 'SQL文を作成するため
'T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
strSQL = "Select 出身地 From T_メンバー " _
& " Where バンドID = " & Me![バンドID]
'レコードセットを開く
rs.Open strSQL, CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
'ループ処理
str出身地 = "" '空文字で初期化
While rs.EOF = False 'いつものEOFが偽の間
'出身地と" "スペース1つを＋する
str出身地 = str出身地 & rs.Fields("出身地") & " "
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
Wend
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
'データのセットと確認メッセージ表示
Me![txt出身地] = str出身地 '非連結のテキストボックスにデータセット
MsgBox "作成した文字列は" & str出身地 & "です"
End Sub |
ポイントは､
^^^^^^^^^^^^
T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
そんなデータがほしかったので、
Select 出身地 From T_メンバー
Where バンドID = 999
SQL文を作りたかったので、
" Where バンドID = " & Me![バンドID]
と、Me![バンドID]フォームの値を使用してます。
あとは、
.Open でレコードセットを開き､
ループの前に変数初期化、
.EOF でレコードセットの終わりを判断､
.Fields("出身地") で、出身地のフィールドにアクセス(値の参照)
str出身地 = str出身地 & rs.Fields("出身地") & " "
で、後ろに＋する。
.MoveNext で､次のレコードに進む
.Close で､レコードセットを閉じて､
Set rs = Nothing 変数もお行儀良く開放
作成結果を
Me![txt出身地] = str出身地 '非連結のテキストボックスにデータセット
で、
非連結のテキストボックスにデータセット
してます。
これで、
「群馬、群馬、群馬、福島」
まで、進みました。
↑テスト結果です。
えっ、進んだ？進んでナイジャン（笑）
/*
* ４．重複をハジク方法
*/
重複をハジク方法、イロイロとあるのですが、
まずは、力技から。
群馬、群馬、群馬、福島
の場合、
初回は群馬をセット、
２回目の群馬は重複しているのでセットしない、
３回目の群馬もセットしない
４回目の福島はセットする。
文字列中から文字列を探す、
存在したら、データはセットしない、
存在しなかったら後ろに＋する
InStr関数を使用してみます。
^^^^^^^^^^^^^^^^^^^^^^^^^^^
Private Sub コマンド15_Click()
Dim str出身地 As String '出身地の管理
Dim n As Integer 'サーチ文字列の発見場所
Dim rs As New ADODB.Recordset 'ADOのレコードセット
Dim strSQL As String 'SQL文を作成するため
'T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
strSQL = "Select 出身地 From T_メンバー " _
& " Where バンドID = " & Me![バンドID]
'レコードセットを開く
rs.Open strSQL, CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
'ループ処理
str出身地 = "" '空文字で初期化
While rs.EOF = False 'いつものEOFが偽の間
'バッファの中に同じ出身地があるか場所をチェックする
n = InStr(str出身地, rs.Fields("出身地"))
If n = 0 Then '出身地が見つからなかったら（重複してない時）
'出身地と" "スペース1つを＋する
str出身地 = str出身地 & rs.Fields("出身地") & " "
End If
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
Wend
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
'データのセットと確認メッセージ表示
Me![txt出身地] = str出身地 '非連結のテキストボックスにデータセット
MsgBox "作成した文字列は" & str出身地 & "です"
End Sub |
ポイントは、
^^^^^^^^^^^^
'ループ処理
str出身地 = "" '空文字で初期化
まずは、バッファを空にする。
While rs.EOF = False 'いつものEOFが偽の間
'バッファの中に同じ出身地があるか場所をチェックする
n = InStr(str出身地, rs.Fields("出身地"))
作成している出身地の変数内に、読み込んだ出身地があるかチェックする。
InStrで見つからない場合、０が返ります、これを判断し、
If n = 0 Then '出身地が見つからなかったら（重複してない時）
'出身地と" "スペース1つを＋する
str出身地 = str出身地 & rs.Fields("出身地") & " "
End If
出身地が見つからなかった場合のみ、出身地を＋してます。
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
Wend
↑テスト結果です。
さてと、完成したし、いっかな。
なんて工夫がないと、
ヤッパ三流プログラマーってＳＱＬ文知らないんだぁ・・・
と、一言メッセージをモラッテシマウノデ、ＳＱＬ文で重複をハジク。
Group Byでグループ化するんダロ？簡単ジャンと思った読者の声を聞きつつ、
ギクっ読まれてるよ行動が。
ホカナイカナァ・・・
DISTINCTキーワード知らないんだぁ？
なにそのキーワード？
騙されたと思って、
Select DISTINCT 〜で、SQL文作ってみなよ
InStrを使う前のプログラムにDISTINCTキーワードを追加してみます。
'T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
strSQL = "Select DISTINCT 出身地 From T_メンバー " _
& " Where バンドID = " & Me![バンドID]
と、Selectの後にキーワードを＋してみます。
Private Sub コマンド14_Click()
Dim str出身地 As String '出身地の管理
Dim rs As New ADODB.Recordset 'ADOのレコードセット
Dim strSQL As String 'SQL文を作成するため
'T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
strSQL = "Select DISTINCT 出身地 From T_メンバー " _
& " Where バンドID = " & Me![バンドID]
'レコードセットを開く
rs.Open strSQL, CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
'ループ処理
str出身地 = "" '空文字で初期化
While rs.EOF = False 'いつものEOFが偽の間
'出身地と" "スペース1つを＋する
str出身地 = str出身地 & rs.Fields("出身地") & " "
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
Wend
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
'データのセットと確認メッセージ表示
Me![txt出身地] = str出身地 '非連結のテキストボックスにデータセット
MsgBox "作成した文字列は" & str出身地 & "です"
End Sub |
テストすると、オッ、できましたね。
SQLの結果で重複をハジクタメだけにグループ化してたけど、
物によっては、
Select DISTINCT
と、重複結果を取り除くキーワードを使ってみるのも面白そうですね。
手前味噌解説に酔ってないで、今、ボタンクリックしないと、
txt出身地にデータセットされないよ。
普通はグループが変わったタイミングで出身地も自動で変えたいよ。
そうでした。どちらの処理でもいいので、
グループが変わったタイミング、
親のフォームのレコード移動時に出身地の取得モジュールを書き込みます。
よし、動作したよと安心したら、
新規のデータを入力しようと、レコードを移動したら、
あらら、エラーだよ。
↑エラーメッセージ
strSQL = "Select DISTINCT 出身地 From T_メンバー " _
& " Where バンドID = " & Me![バンドID]
と、Me![バンドID]を参照しようとするが、
新規のデータなので、番号が無かったみたいです。
チェックを入れないとダメなのかぁ。
なんか、無いかなぁ・・新規レコードを判断するプロパティ。
探すと、そのまんまの、.NewRecordってプロパティがあった（笑）
'新規のデータ時、下の処理を走らせない
If Me.NewRecord = True Then '.NewRecordで新規かチッェクする
Me![txt出身地] = "" '空文字でクリア
Exit Sub '関数を途中で抜ける
End If
とチェックを入れて、新規データ追加時は、
出身地のデータはチェックしないことにしました。
下記、作成したレコード移動時のイベントです。
Private Sub Form_Current()
Dim str出身地 As String '出身地の管理
Dim rs As New ADODB.Recordset 'ADOのレコードセット
Dim strSQL As String 'SQL文を作成するため
'新規のデータ時、下の処理を走らせない
If Me.NewRecord = True Then '.NewRecordで新規かチッェクする
Me![txt出身地] = "" '空文字でクリア
Exit Sub '関数を途中で抜ける
End If
'T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
'DISTINCTキーワードで重複をハジク
strSQL = "Select DISTINCT 出身地 From T_メンバー " _
& " Where バンドID = " & Me![バンドID]
'レコードセットを開く
rs.Open strSQL, CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
'ループ処理
str出身地 = "" '空文字で初期化
While rs.EOF = False 'いつものEOFが偽の間
'出身地と" "スペース1つを＋する
str出身地 = str出身地 & rs.Fields("出身地") & " "
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
Wend
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
'データのセット
Me![txt出身地] = str出身地 '非連結のテキストボックスにデータセット
End Sub |
-【けんぞう！】---------------------------------------------------------
三流君の、小金稼ぎ、お小遣い稼ぎシリーズ第３弾（稼げないだろコラ！！）
参加無料：予想が当たれば一攫千金？今月はプロ野球のセパ勝敗とホームラン数
http://www.ken3.org/etc/500yen/5050.html ← 100万を当たった人数で山分け
『チッ、大穴横浜の勝利に賭けてるのに当たらない（笑）』（横浜ファン：31歳）
------------------------------------------------------------------------
↑※７／１３日の日曜日、雨で三試合中止 And 松坂の１回ノックアウト、、
大波乱、当てた人居るのかなぁ・・・雨で中止、読めなかった・・・
参加料無料なので、試合によっては一攫千金を狙えますよ。
当たっていない私が言うと説得力無いけど、みなさんは実力で稼いでください。
/*
* ５．終わりの挨拶
*/
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba106.lzh
にdb106.mdb(Access2000版)が保存されています。
動作を見るのが一番早いかも。
今回は、
テーブルから重複値をハジク方法で、
InStrで探して追加しない方法
と
Select DISTINCT キーワードを使用して、
SQL文で重複結果を返さない方法の２つをテストしてみました。
あと、おまけで、レコード移動時に新規レコードか？判断するときは
.NewRecordプロパティを参照しました。
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜Access サブフォームの明細データを検索、メインを移動＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
読者よりもらった質問の続きを、処理してみたいと思います。
内容は、サブフォーム内のデータを検索して、
メインのデータを移動、そんな感じです。
いつものように、たいした解説、回答内容じゃないので、
暇つぶしに休み時間などに拾い読みしてください。
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba107.lzh
にdb107.mdb(Access2000版)が保存されています。
/*
* １．今回のキッカケ
*/
メールで下記の質問をもらいました。
----
>例としまして（本当はもっとドロドロしたデータベースなんですが、
> 違う例えで書いてみました。）
>
>親フォームが音楽のバンド名が記載されてます。
>サブフォームには、
>そのバンドのメンバーと出身県と楽器と年齢などが記載されています。
>
>そこで、親フォームには、そのバンドのメンバーの出身県が出るテキスト
>ボックスがあります。
>
>例えば・・・バンド名（BOOWY）−−−−−−−−−−親フォーム
> メンバー（氷室、布袋、松井、高橋）−−サブフォーム
> 出身県（群馬、群馬、群馬、福島）−−−サブフォーム
>
>●質問１
>
>で、このサブフォームに記載されている、出身県を親のフォームの
>任意に作成したテキストボックスの中に「群馬、福島」とだけ表示したいのです。
>
>「群馬、群馬、群馬、福島」と表示するのは、ちょっと・・・。
>群馬がだぶっているので、群馬の表示は１つとしたいのです。
>
>
>●質問２
>
>また、沢山のバンドや歌手をこのデータベースに入力します。
>そこで、「布袋」と検索すると、親フォームの「BOOWY」が表示されるようにしたい
>のです。
>
>まず親フォームのバンド名には
>「バンドID」と云う名のフィールド名の主キー（オートナンバー）がありまして
>
>それをサブフォームの中にもフィールド名で、 同じ「バンドID」という
>固有のデータで繋がっているです。
>
>こんな説明で分かってもらえるんでしょうか・・・。
>すごく不安です。
-----
２つの親子テーブルが存在して、
バンドIDでつなげた、フォーム・サブフォームが存在する。
前回、サブフォームを作成して、
出身地をまとめる処理までやりました。
http://www.ken3.org/backno/backno_vba22.html#106
詳細は、↑を見てください。
今回は、サブフォーム（明細的子データ）のバンドのメンバー名を探して、
親フォーム、バンド名（台帳的親データ）を探して、移動してみたいと思います。
/*
* ２．調べごと、下準備
*/
親テーブル名:T_バンド名
バンドID オートナンバー
バンド名称 テキスト
備考 メモ型
子テーブル名：T_メンバー
個人ID オートナンバー
バンドID 長整数型（親テーブルとリンクする）
名前 文字型
楽器 文字型
出身地 文字型
生年月日 日付型 *今回関係ないけど
備考 文字型 *今回関係ないけど
なんて、テーブル構成にして、フォームを作成しました。
この親フォームに
検索用の非連結のフィールドと検索ボタンを追加します。
メンバー名検索[ ______ ] 検索
(txt検索 ) (btn検索)
/*
* ３．DLookUp関数でデータを探す
*/
まずは、固定処理でテストする。
>●質問２
>
>また、沢山のバンドや歌手をこのデータベースに入力します。
>そこで、「布袋」と検索すると、親フォームの「BOOWY」が表示されるようにしたい
>のです。
子テーブル名：T_メンバー
の
名前が「布袋」のデータを検索して、
バンドID 長整数型（親テーブルとリンクした）
を検索したいので、
DLookUP関数を使ってみました。
Private Sub コマンド19_Click()
Dim str検索されたID As String
'メンバー名を条件にバンドIDをT_メンバーテーブルから検索する
str検索されたID = "" & DLookup("バンドID", "T_メンバー", "名前 = '布袋'")
'テスト表示
MsgBox str検索されたID
End Sub |
上記、固定の条件ですが、ID番号を検索できました。
これを元にして、フォームの値を使用してみます。
Private Sub コマンド19_Click()
Dim str検索条件 As String
Dim str検索されたID As String
'フォームの値を元に検索条件を作成する
str検索条件 = "名前 = '" & Me!txt検索 & "'"
'str検索条件を条件にバンドIDをT_メンバーテーブルから検索する
str検索されたID = "" & DLookup("バンドID", "T_メンバー", str検索条件)
'結果のテスト表示
If str検索されたID = "" Then '検索できなかった?
MsgBox Me!txt検索 & "は、見つかりませんでした"
Else
MsgBox "検索されたのは" & str検索されたID & "です"
End If
End Sub |
ポイントは、
^^^^^^^^^^^^
str検索条件 = "名前 = '" & Me!txt検索 & "'"
と、
名前 = 'テキストボックスの値'
の条件を作成します。
あとは、検索されたIDをチェックと表示してます。
/*
* ４．検索系のコマンド(命令)を探る
*/
さてと、IDがわかったので、そのIDに移動したいですよね。
コマンドボタンウィザードでボタンを簡単に作れますよね、
よく、次のレコードに移動、などのボタンを作っていると思います。
同様に、何かないかなぁと探ってみると、
レコードの移動のグループに次を検索とボタンが作れます。
↑ウイザードのイメージ
で、自動作成されたのが下記のモジュールです。
Private Sub コマンド20_Click()
On Error GoTo Err_コマンド20_Click
Screen.PreviousControl.SetFocus
DoCmd.FindNext
Exit_コマンド20_Click:
Exit Sub
Err_コマンド20_Click:
MsgBox Err.Description
Resume Exit_コマンド20_Click
End Sub |
F1を押して、コードを探ってみます。
Screen.PreviousControl
最後にフォーカスを与えられたコントロールへの参照
んっ、あまり関係ないような・・・
気を取り直して、
DoCmd.FindNext メソッド を同様にF1(HELP)探ると
解説
このメソッドには引数はありません。
構文 DoCmd.FindNext で直接呼び出すことができます。
FindNext メソッドは、前回実行した FindRecord メソッド、または [編集] メニュー
の [検索] をクリックすると表示される [検索と置換] ダイアログ ボックスで指定し
た抽出条件を満たす次のレコードを検索するために使用します。FindNext メソッドを
使用すると、レコードを繰り返し検索できます。たとえば、すべてのレコードの中から
特定の得意先のレコードを連続して検索できます。
なんだよ、これもハズシかよ・・・と思ったが、よく見ると、
前回実行した FindRecord メソッド？
おっ、なんかこのFindRecordって条件指定できそうな予感。
FindRecord メソッド
expression.FindRecord(FindWhat, Match, MatchCase, Search,
SearchAsFormatted, OnlyCurrentField, FindFirst)
使用例
次の例では、カレント フィールドに "山田" という名前が格納されているレコードの
うち最初のレコードを検索します。"やまだ" や "山田山" は検索されません。
DoCmd.FindRecord "山田",, True,, True
なるほどね、では、ID=2に移動する場合は、
カレントフィールドをIDにして、
DoCmd.FindRecord "2"
でいいのかなぁ。テストしてみると。
Private Sub コマンド20_Click()
DoCmd.GoToControl "バンドID" 'コントロールをIDへ移動
DoCmd.FindRecord "2" '2のデータを検索する
End Sub |
ポイントは、
^^^^^^^^^^^^
DoCmd.GoToControl "バンドID"
で、カレントコントロールを移動
DoCmd.FindRecord "2"
で
バンドIDが２のデータに移動しました。
/*
* ５．組み合わせて、組み込んでみた
*/
DLookUpで子テーブルがバンドIDを求めることに成功しました。
DoCmd.FindRecord で、レコードを移動できました。
これを組み合わせてみます。
Private Sub btn検索_Click()
Dim str検索条件 As String
Dim str検索されたID As String
'フォームの値を元に検索条件を作成する
str検索条件 = "名前 = '" & Me!txt検索 & "'"
'str検索条件を条件にバンドIDをT_メンバーテーブルから検索する
str検索されたID = "" & DLookup("バンドID", "T_メンバー", str検索条件)
'結果のテスト表示
If str検索されたID = "" Then '検索できなかった?
MsgBox Me!txt検索 & "は、見つかりませんでした"
Else
'データを移動させる
DoCmd.GoToControl "バンドID" 'コントロールをIDへ移動
DoCmd.FindRecord str検索されたID 'データを検索する
End If
End Sub |
処理のポイントは、
~~~~~~~~~~~~~~~~~~
DLookUp関数で子テーブルから画面に入力された条件を指定して
バンドIDを検索する。
バンドIDが存在したら、
DoCmd.GoToControl "バンドID"でカレントコントロールを移動、
カレントコントロール(バンドID)に対して、
DoCmd.FindRecord str検索されたID
と、検索されたバンドIDを渡し、目的のデータを検索します。
まぁ、なんとか動作しました・・・
/*
* ５．終わりの挨拶
*/
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba107.lzh
にdb107.mdb(Access2000版)が保存されています。
動作を見るのが一番早いかも。
今回は、
DLookUpでテーブルの検索、
DoCmd.FindRecord で検索したレコードへ移動
そんな組み合わせの処理でした。
実は、まだまだ、穴があって、
穴その１は、鈴木や田中、メンバー名、同じ人がいた時?複数データが見つかった時。
穴その２は、
DoCmd.GoToControl "バンドID"
と、バンドIDにコントロールを移動させているが、
オートナンバー等の時、バンドIDは非表示にしていたりする(可視=いいえ)
すると、バンドIDが見つからない(カレントコントロールに出来ない)
なんてエラーが発生する。
↑エラーのイメージ
複数レコードが該当(メンバー名で同じ名前)した場合
と
親子共通のID、バンドIDを非表示で管理していた場合、
DoCmd.GoToControl DoCmd.FindRecord で検索の手が使えない。
さて、対策を取らないとね。
メンバー名が同じって、１人が複数のグループに在籍ってあるだろうし、
よくわからない、有名なシャッフルユニットとか？
あとは、データがフルネームで入っていない場合とか
あっ、データがフルネームで気が付いたけど、
テーブルにはフルネームで入っているけど検索は一部でしたいなんてあるのかも。
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜IE アプリケーションのイベントを横取りする＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
IEで発生するイベントを横取りしてみます。
いつものように、たいした解説、回答内容じゃないので、
暇つぶしに休み時間などに拾い読みしてください。
/*
* １．今回のキッカケ
*/
メールで下記の質問をもらいました。
----
>アクセスからIEにはsendkeys を使ってデータを
>移動できますが、その逆を考えているのですが
>うまい方法はありませんでしょうか.
>
>IE フォーム から アクセスのフォーム
>また、テーブルに直接でも間接でも宜しい
>のですが？
----
IEのデータを取るのかぁ、、、タイミングがなぁ・・・
/*
* ２．調べごと、下準備
*/
以前、ランキングページからデータを取り込む処理で、
No.52 InternetExplorer.application .document.body.innerText
http://www.ken3.org/backno/backno_vba11.html#52
を参照
Sub ie_get_itext() 'VBA052で解説
Dim objIE As Object 'ＩＥオブジェクト参照用
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
'ランキングのページに飛ぶ
objIE.Navigate "http://www.ken3.org/cgi-bin/lime/limemgr.cgi"
'表示されるまで待つ、10秒後にエラーを判断する
Dim time10 As Date '時刻格納用
time10 = DateAdd("s", 10, Now()) '現在から１０秒後を計算
Do While objIE.Busy = True 'ビジー、読み込み中の間
DoEvents
If time10 < Now() Then '１０秒経過したか？
MsgBox "タイムアウトです"
Exit Sub
End If
Loop
'innerTextを取出す
Dim strTEXT As String
strTEXT = objIE.document.body.innerText '変数に代入
Debug.Print strTEXT 'イミディエイトにも表示
'UserFormを開く(確認用)
frmINFO.txtINFO.Value = strTEXT 'HTMLを代入
frmINFO.Show 'フォームを開く
End Sub |
ポイントは、
~~~~~~~~~~~
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
を作って、
'表示されるまで待つ、10秒後にエラーを判断する
Dim time10 As Date '時刻格納用
time10 = DateAdd("s", 10, Now()) '現在から１０秒後を計算
Do While objIE.Busy = True 'ビジー、読み込み中の間
DoEvents
If time10 < Now() Then '１０秒経過したか？
MsgBox "タイムアウトです"
Exit Sub
End If
Loop
と
表示されるまで、じっと、.Busyをストーカーのように観察して
彼女が読み込み待ちじゃなくなったら（笑）or10秒であきらめ（笑）
つかさず、声をかけ（オイオイ）
strTEXT = objIE.document.body.innerText '変数に代入
で、変数に表示結果を代入してます。
これは、プログラムは上から下への基本通りなんで、
プロパティなど、難しいけど、理解すれば簡単です。
流れは、
・ＩＥのオープン --------- CreateObject("InternetExplorer.application")
・ＩＥで指定ページを開く - objIE.Navigate "URLのとび先を指定"
・読み込み待ち ---------- objIE.Busy = True
・データを代入 ---------- strTEXT = objIE.document.body.innerText
と上から下にチェックしながら流れます。
今回の処理は、たぶん、
ＩＥ（ＨＴＭＬ）のフォームで条件を入力、検索を行う、
検索結果をＡｃｃｅｓｓのテーブルに代入する。
そんな、流れだと思います。
問題ないじゃん？なにか？問題あるの？
条件を入力して、終了したタイミングが取れないんですよ。
条件入力後、SUBMIT後、データを受け取ったら・・・がよくわからない。
※ＩＥで入力して、結果が得られる、それを横取りしたいので。
/*
* ３．IEのイベントを横取りする
*/
http://msdn.microsoft.com/msdnmag/issues/02/04/ednote/default.aspx
ここ見ても、よくわからないんだけど、
英語は、イヤだよ・・・
Dim WithEvents IE As InternetExplorer
Private Sub StartIE
Set IE = CreateObject("InternetExplorer.Application.1")
IE.Visible = True
End Sub |
You have to create the Internet Explorer object with the WithEvents
keyword, which lets you hook its events in your code. Next,
you can hook this object's NewWindow2 event:
Private Sub IE_NewWindow2(ppDisp As Object, Cancel As Boolean)
Set IEx = CreateObject("InternetExplorer.Application.1")
Set ppDisp = IEx
IEx.Visible = False
End Sub |
Private Sub IEx_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, _
Flags As Variant, TargetFrameName As Variant, PostData As Variant, _
Headers As Variant, Cancel As Boolean)
' Figure out whether the URL requested is on the banned list
' If it is, never show the window or navigate to the site.
' Otherwise, let it through normally.
End Sub |
なんだこれ？の
Dim WithEvents IE As InternetExplorer
を探る、
http://www.microsoft.com/japan/msdn/library/ja/vblr7/html/vakeyWithEvents.asp
WithEvents を 見るが、イマイチ。。。
宣言されるオブジェクト変数がイベントを発生させることのできる
クラス インスタンスを参照することを示すキーワードです。
へっ？なに？まぁ、わかんないから書いてみよう。
さてと、どうしましょうかねぇ。
テストで新しいウインドウを開くイベントを横取りしてみます。
'忘れずに、MicroSoft Internet Controls を参照設定してください
Dim WithEvents IE As InternetExplorer
Private Sub コマンド1_Click()
'普通にIEのオブジェクトを作成する
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True '可視をON
IE.GoHome '初期ページに移動する
End Sub |
'こんなんで、横取りできるの？
Private Sub IE_NewWindow2(ppDisp As Object, Cancel As Boolean)
MsgBox "新しいウインドウを開こうとしてます"
End Sub |
で、無事、右ボタンを押して新規ウインドウを起動すると、
新しいウインドウを開こうとしてます
とメッセージが表示されました。
Dim WithEvents IE As InternetExplorer
と
WithEventsキーワードを使って、
IE_NewWindow2(ppDisp As Object, Cancel As Boolean)
と書くだけでＯＫです。
おっと、これは、
Set IE = CreateObject("InternetExplorer.Application")
と、ＩＥのアプリを外側に起動した場合です。
挿入・ActiveXコントロールで
Microsoft Web Browser コントロールをフォームに貼った場合は、
もっと簡単で、
フォームのロードイベントで表示して、
Private Sub Form_Load()
'フォームのロードイベントでGoHomeしてみる
Me![WebBrowser0].GoHome '初期ページへ移動
End Sub |
Private Sub WebBrowser0_NewWindow2(ppDisp As Object, Cancel As Boolean)
MsgBox "新しいウインドウを開こうとしてます"
End Sub |
で、同じ処理できました。
新規ウインドウを開いたテスト結果↑
WithEventsのキーワード無くて、
~~~~~~~~~~
WebBrowser0_NewWindow2(ppDisp As Object, Cancel As Boolean)
で動いたのは、意外だったけど。
あっ、当たり前なのかも？
だって、ボタンだったら、
ボタンのコントロール名_Click
で、クリック処理ですよね。
フォームに貼ったMicrosoft Web Browser コントロールのイベントだからか。
ってことは、他のイベントも選択可能かも。
VBAの編集画面で選択してみる。
↑コントロールの選択
↑イベントの選択
/*
* ４．読み込み完了のイベントを横取りしてみる
*/
話を戻してと、
やりたいのは、ＩＥ上で検索したデータ結果を取り出したい？
なので、ＩＥで検索まではユーザーに勝手に操作してもらう。
ユーザーが検索すると、画面の更新（データの読み込み）が発生して、
その後、読み込みが完了する。
読み込み完了、そんなイベントを探ってみます。
DocumentCompleteってイベントがあるらしい。
チッまた英語かよ・・なんか疲れた（笑）
http://msdn.microsoft.com/workshop/browser/webbrowser/reference/events/documentcomplete.asp
Syntax
Private Sub object_DocumentComplete( _
ByVal pDisp As Object, _
ByVal URL As Variant)
Parameters
object
Object expression that resolves to the objects in the Applies To list.
pDisp
Object that specifies the top-level or frame WebBrowser object
corresponding to the event.
URL
String that specifies the URL, Universal Naming Convention (UNC) file name,
or pointer to an item identifier list (PIDL) of the loaded document
まぁ、読めないものはショウガナイ、まずはテストしてみます。
_DocumentComplete
のイベントが発生したら、.TitleとBodyの中身をテキストボックスに代入してみます。
Private Sub WebBrowser0_DocumentComplete(ByVal pDisp As Object, URL As Variant)
'ダウンロード終了時に発生すると仮定して
'タイトルの代入
Me![txtTITLE] = Me.WebBrowser0.Document.Title
'HTMLの代入
Me![txtHTML] = Me.WebBrowser0.Document.body.innerhtml
End Sub |
読み込みが完了した時点で、
タイトルとbodyのソースをテキストボックスへ代入してます。
-【けんぞう！】---------------------------------------------------------
三流君の、小金稼ぎ、お小遣い稼ぎシリーズ第３弾（稼げないだろコラ！！）
参加無料：予想が当たれば一攫千金？今月はプロ野球のセパ勝敗とホームラン数
http://www.ken3.org/etc/500yen/5050.html ← 100万を当たった人数で山分け
『チッ、大穴横浜の勝利に賭けてるのに当たらない（笑）』（横浜ファン：31歳）
------------------------------------------------------------------------
/*
* ５．終わりの挨拶
*/
今回は、
IE アプリケーションのイベントを横取りする
方法でした。
_NewWindow2 で、新規ウインドウのイベント、
_DocumentComplete で、読み込み完了のイベント、
そんなイベントを横取りしてみました。
パターン１は、WithEventsキーワードを使って、
Dim WithEvents IE As InternetExplorer
と
IE_NewWindow2(ppDisp As Object, Cancel As Boolean)
みたいに、書くだけ。
パターン２は
フォームに貼ったMicrosoft Web Browser コントロールのイベントだから
普通に、
WebBrowser0_DocumentComplete
WebBrowser0_NewWindow2
など、イベントを記述可能なことをテストしました。
ＩＥで画面が更新された=_DocumentCompleteのドキュメントが読み込まれた
と判断して、ユーザーが任意のタイミングで検索した結果を受け取るタイミング
を作り出してます。
あとは、力技や、出力結果のＨＴＭＬを見て（解析して）、
データを抜き出せば、なんとかなると思います。
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba108.lzh
にdb108.mdb(Access2000版)が保存されています。
が、
Microsoft Web Browser コントロールをフォームに貼っているので、
バージョン違いなどで動かない可能性があります。
テストでエラーが発生しても、怒らないでくださいね。
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜Excel Selectionプロパティで選択範囲を処理する＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
メールでもらった質問、
現在選択中のセルについて、探ってみます。
いつものように、たいした解説、回答内容じゃないので、
暇つぶしに休み時間などに拾い読みしてください。
/*
* １．今回のキッカケ
*/
メールで下記の質問をもらいました。
----
>エクセルで範囲を指定したところだけマクロを実行するにはどうすれば良いのですが
>？
>最近はMMの量（発行量）が多すぎて読むのに苦労しています。
>お手数ですがご教授をお願いします。----
----
メルマガの量が多いのかぁ・・一回一回が薄いので、回数でカバーしてるんだけど、
回数が多いとうんざりする、そんな女性もいたりしてね（なんの話だよ・・？）
たしかに、連続発行すると解除者が増えるんだよなぁ。
遠距離恋愛で２・３ヶ月に一度は困るけど、
毎日もうざい、そんな感じなんだろうなぁ？
会話でネタがツキナイヨウニいつも新鮮な話題を提供しないと。
ご教授？そんなレベルじゃないけど、今回も回答します。
ハヤク始めろって？
いつもの前置き（前○）が長かったですね（謎？）
/*
* ２．プログラムの中でタイミングを取れると楽
*/
範囲指定した部分だけマクロの実行。
一番簡単なのは、プログラムの中でタイミングを取れると楽ですよね。
タイミングを取る？
イベント起動型のプログラムとはいっても、
~~~~~~~~~~~~~~~~~~~~~~~~~~
個々のプログラムは上から下へ、
分岐したり、ループしたり、途中で抜ける、エラー処理に飛ぶ、
と
プログラムを組んでます。
簡単なのは、範囲指定をプログラム中に組み込んでしまう方法。
No.102 Excel 範囲を選択して、カンマ区切りのファイルを作る
http://www.ken3.org/backno/backno_vba21.html#102
で、作りかけなんだけど（最後まで出さないと体に悪いのに・・・？）
プログラムの頭で（頭のタイミングで）、
Dim objTARGET As Range '選択されたセルの集合
Set objTARGET = Application.InputBox(prompt:="セルを選択", Type:=8)
と、
Application.InputBox(prompt:="セルを選択", Type:=8)
を使用して、セル範囲を選択させる。
で、
選択された範囲を
'テーブルデータを作成する
Call MAKE_CSV_FILE(strFNAME, objTARGET)
と、関数へ渡す。
For y = 1 To objHANI.Rows.Count '行のループ
For x = 1 To objHANI.Columns.Count '列のループ
で、ループを作り、データの書き出しを行っています。
処理の流れは簡単で、
１．プログラム Sub Mainが起動される
２．Application.InputBoxでセルを選択させる
３．選択範囲に対して、処理を行う
と、ワンセットになってます。
Sub Main()
'Application.InputBoxでセルを選択させる
Dim objTARGET As Range '選択されたセルの集合
Set objTARGET = Application.InputBox(prompt:="セルを選択", Type:=8)
If IsEmpty(objTARGET) Then 'キャンセルが押されたかチェックする
MsgBox "キャンセルが押されました"
Exit Sub
End If
'ファイル名を作成 ファイル名は自分のパス+\test.html
Dim strFNAME As String 'ファイル名保存用
strFNAME = ThisWorkbook.Path & "\test.csv" 'ファイル名を作る
'テーブルデータを作成する
Call MAKE_CSV_FILE(strFNAME, objTARGET)
'できたファイルをメモ帳で表示して確認する
Shell "notepad.exe " & strFNAME '手抜きでShellで起動
'終わりの挨拶
MsgBox strFNAME & "を作成しました"
End Sub |
Sub MAKE_CSV_FILE(strFNAME As String, objHANI As Range)
'ファイルをオープンする
Dim FNO As Integer 'ファイル番号
FNO = FreeFile '空いてるファイル番号を取出す
Open strFNAME For Output As #FNO 'テキストファイルを新規作成
'行、列でループを作る
Dim y As Integer
Dim x As Integer
For y = 1 To objHANI.Rows.Count '行のループ
For x = 1 To objHANI.Columns.Count '列のループ
Print #FNO, objHANI.Cells(y, x).Value;
Print #FNO, ",";
Next x
Print #FNO, "" '改行のみ出力
Next y
'ファイルをクローズする
Close #FNO
End Sub |
/*
* ３．範囲を選択してからプログラムを起動する
*/
何言ってるの？基本的な処理は同じだろ？と言われる人もいるかもしれませんが。
もう一つの操作方法として、
範囲を選択してから、各種プログラムを実行するパターンがあります。
どんな処理だよ、そんな処理無いよ？
まぁまぁ、そんなに怒らないでよ。
セルをドラッグしてから（範囲を選択してから）
・右ボタンのコピーを押したりしてコピーしてるよね？
・範囲を選択してからＢの太字の強調ボタン押してるよね？
・範囲を選択してからフォントの色、変更しているよね？
それは、Ｅｘｃｅｌの中だから？と言われるけど、
大きなワクの流れで言えば、
１．好きな範囲を選択する（対象を決める、顔、唇、○○○の範囲に手を持っていく）
２．その範囲に対してコピーのプログラム、太字の強調と処理が走る
（その範囲に対して、キス、なでる、○○、○○と動作が走る）
チョット例題がおかしいけど（本や学校じゃ使わない、例題だけど）
範囲選択後、個々のプログラムが、その範囲に対して処理を行う。
簡単に言うと、
オブジェクト（対象）を選択してから、処理が走る。
そんなイメージです。
※初めから↑って書けよ。
さてと、そんな処理を書きたい場合は、
選択されているオブジェクト（セル範囲）を知りたいですよね。
そんな時は、
Sub ボタン1_Click()
Selection.Font.Bold = True
End Sub |
と、
Selection プロパティ
を使うことも出来ます。
下記、Excel2002のヘルプから引用
>Application オブジェクトでは、アクティブ ウィンドウで現在選択されている
>オブジェクトを返します。Windows オブジェクトでは、指定されたウィンドウで
>現在選択されているオブジェクトを返します。
>
>解説
>Selection プロパティで返されるオブジェクトの種類は、何を選択するかによって
>異なります。たとえば、セルを選択しているときは、Range オブジェクトが返されます
>何も選択していないときは Nothing が返されます。
>
>次の使用例は、シート 1 の選択範囲を消去します。選択しているのは、
>セル範囲であるものとします。
>Worksheets("Sheet1").Activate
>Selection.Clear
>
>次の使用例は、選択しているオブジェクト型を表示します。
>Worksheets("Sheet1").Activate
>MsgBox "選択されているオブジェクト型は" & TypeName(Selection)
コッチのほうが、有名かもしれないのは、
ActiveCell プロパティ かな
~~~~~~~~~~
私も今回気が付いたけど、
ヘルプを見ると気になる記述が書いてある、その気になる部分は、
>解説
>対象となるオブジェクトを指定しない場合は、
>アクティブ ウィンドウのアクティブ セルが返されます。
>
>アクティブ セルと選択セル範囲を混同しないように注意してください。
えっ、混同するなって？
>アクティブ セルは、現在の選択セル範囲内の単一セルを指します。
>選択セル範囲には、複数のセルが含まれる場合がありますが、
>アクティブ セルはその中の 1 つだけを指します。
何い？１つしか返さないの？オイオイ・・・
いままで、気が付かなかった（笑）、だから三流なんだって？
読者質問で１つ賢くなったよ。
下記、動作比較する、簡単なサンプルです。
Sub ボタン1_Click()
MsgBox "ActiveCell.Addressは、" & ActiveCell.Address
MsgBox "Selection.Addressは、" & Selection.Address
End Sub |
両方の、.Addressプロパティを表示してみました。
結果は、こんな感じです。
.Addressのテスト結果↑
たしかに、
ActiveCell.Address は、単一のアドレス
Selection.Address は、複数のアドレスだった。
/*
* ４．あとは、Selection.に対して処理を行う
*/
さてと、方針が見えたら、あとは、Selection.に対して処理を行います。
今日は、少し丁寧に作ってみます。
普段は、
If TypeName(Selection) <> "Range" Then
なんてチェック入れないけど（オイオイ）
TypeName(Selection)で選択されたオブジェクトのタイプをチェックします。
グラフオブジェクトを選択して、処理が走るのを防止してます。
※逆に、グラフを選択させて、処理を実行する、
そんな処理も作れるんだなぁと思いました。
で、Range型だったら、
For Each 〜 IN で、
For Each objRANGE In Selection.Cells
と、選択されたセルを取り出しながら処理してます。
洒落た例題思いつかなかったので、
100以下なら赤、その他は青にフォントのカラーを変えてみました。
Sub ボタン1_Click()
'選択範囲がRange型かチェックする
'グラフを選択されていたりするのを防止したかったため
If TypeName(Selection) <> "Range" Then
MsgBox "変なとこ触るなよ、セルを選択してよ"
Exit Sub 'Range以外は抜ける
End If
'テストで範囲の表示
MsgBox "選択範囲は、" & Selection.Address
'ループさせて処理を行う
Dim objRANGE As Range
For Each objRANGE In Selection.Cells
If objRANGE.Value < 100 Then '数値が100以下なら
objRANGE.Font.Color = RGB(&HFF, 0, 0) '赤にする
Else
objRANGE.Font.Color = RGB(0, 0, &HFF) '青にする
End If
Next
End Sub |
-【けんぞう！】---------------------------------------------------------
三流君の、小金稼ぎ、お小遣い稼ぎシリーズ第２弾（稼げないだろコラ！！）
http://www.ken3.org/etc/500yen/yosou.html
キャンペーン参加で得たコインを予想問題に投票。正解するとコインが倍増、
それを換金という画期的“お得エンタメ”です。
運と実力で誰でも現金獲得のチャンスがあります。
思ったよりもあたらないけど、無料なのでチャレンジしてみては？
------------------------------------------------------------------------
/*
* ５．終わりの挨拶
*/
今回は、
・Selectionで、選択範囲を参照する
・ActiveCellとSelectionの違い
・処理のタイミングについて
そんなお話でした。
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
検索して目的の情報を探す。
目的の情報を探すには、最近はググれとよく聞きます。なので、検索ボックスを付けました。
いろいろなキーワードを入れて、検索してみてください。
ページフッター
ここまで、読んでいただきどうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。
質問や要望など メッセージを送る(三流君に連絡する)
質問や要望など連絡方法でお互い確認が取りやすく、便利なのが掲示板なのですが、私の対応のまずさから不定期で荒れてしまい、掲示板は現在封鎖中です。(反省しなきゃ)
|
|
感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。
|
急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。
リンクや広告など
項目別に↓に人気の記事をまとめてみました。お探しのジャンルを選択してください。
人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記３つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。
開発時の操作:
[F1を押してHELPを見る]/
[Debug.Print と イミディエイトウインドウ]/
[実行時エラーでデバッグ]/
[ウォッチ式とSTOP]/
[参照設定を行う]
仕様書(設計書？) XXXX書類:
[基本設計書や要求仕様書]/
[テスト仕様書 テストデータ]/
[バグ票]/
[関数仕様書]/
[流れは 入力・処理・出力]
Excel関係:
[Excel UserFormを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
[Excel関係 関数、その他]・・・その他Excel関係です
Access関係:
[Access UserForm/サブフォーム 操作]・・・アクセスでフォームを使ったサンプルです
[Access レポート操作]・・・レポートを操作してみました
[Access クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です
その他：VBAの共通関数やテキストファイルの操作など
[VBAでテキストファイル(TextFile)の操作]・・・普通のテキストファイルを使ったサンプルです
[VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます
Blog:[三流君の作業日記]/
[サンプルコードのゴミ箱]/
広告-[通販人気商品の足跡]
[三流君(TOP ken3.org へ戻る)]
/ [VBA系TOPへ]
/ [VBA系バックナンバー目次へ移動]
