三流君 ＶＢＡで楽しくプログラミング(Excel/Access VBAの解説/サンプルです)
[VBA系のバックナンバー]
[VBA系 TOP]
[三流君 TOP]
＜Excel VBA テキストファイルで.htmlの雛型を作成する＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
セルに入力したマスターデータを使用して、
テキストファイル(html)を作成してみます。
なんていってても、普通のファイル作成処理です。
/*
* １．やりたいこと 概要
*/
宿・ホテル予約の広告ページを作って儲けようと考えている、
三流プログラマーが東京の田舎に住んでました。
広告、貼っただけじゃ予約取れないからなぁ〜
よし、都道府県別のhtmlを作って、特集ページにするか？
北海道 hokk.html
・
・
東京 tokyo.html
神奈川 kanagawa.html
・
・
大阪 osaka.html
・
・
と47都道府県作ってやるか。
雛型は、
<html>
<head>
<title>北海道 宿・ホテルの予約／検索</title>
</head>
<body>
<h1>北海道 宿・ホテルの予約／検索</h1>
北海道の宿・ホテルの予約や検索サイトをまとめています。<br>
クリックして探してみてください<br>
あとでバナー広告をここに貼る。<br>
</body>
</html>
手打ちで、上記ファイルを作成して、xxx.htmlとして、
あとは、
hokkaidou.html...kanagawa.htmlとHTMLを４７個ファイルをコピーしてリネーム、
開いて都道府県名を打ち込むのも芸が無いしなぁ。
Excelに地区、県名、ファイル名を貼り付けて、
HTMLの雛型ファイルを作成してみたいと思います。
A列 B列 C列
9行 地域 都道府県 ファイル名
10行 北海道 北海道 hokkaidou.html
11行 東北 青森県 aomori.html
・ ・
・ ・
・ ・
沖縄県 okinawa.html
と、データを入力してから、VBAでファイルを作成してみたいと思います。
↑シート作成イメージ
/*
* ２．テキストファイル作りの基本
*/
htmlファイルって言っても、普通のテキストファイルなんだよね。
なんて話を、
テキストファイル処理 ファイルへの書き込み
http://www.ken3.org/vba/backno/vba027.html
でしてました。
新規のテキストファイル作成の基本は、
開けて（Open）、書いて(Print #)、閉めて(Close)
です。
あとは、D:\aaa.txtと絶対パス指定
か
ThisWorkbook.Path & "\aaa.txt"
とファイル名をブックと同じ位置に置いたりするぐらいかなぁ。
Sub test001()
Dim strFNAME As String 'ファイル名格納用
'ブックと同じ位置にtest165.htmlを作成する
strFNAME = ThisWorkbook.Path & "\test165.html" 'ファイル名の作成
Open strFNAME For Output As #1 'ファイル番号１で新規作成
'データ書き込み、
Print #1, "<html>"
Print #1, Now & "です"
Print #1, "</html>"
Close #1 '開いたら閉じようね
'終了メッセージの表示
MsgBox strFNAME & "を作成しました、確認してね"
End Sub |
こんな感じで、htmlファイルを簡単に作ることができます。
/*
* ３．ループの作り方いろいろ
*/
次のポイントは、シートからファイル名を取得して、
そのファイル名でxxxx.htmlとファイルを作成するんだろ。
データ数分ループを作りますか。
47都道府県で、10行目からなので、
Sub test002()
Dim y As Integer 'ループのカウンター
For y = 10 To 56
Debug.Print Cells(y, "B") 'B列をテスト表示
Next y
End Sub |
と、
回す人も居れば、47って数字に意味を持たせるために、
Sub test002()
Dim y As Integer 'ループのカウンター
For y = 1 To 47
Debug.Print Cells(9 + y, "B") 'B列をテスト表示
Next y
End Sub |
と、1から47のループを作る人も居ます。
都道府県はまず可変にならないんだけど、
可変になっても対応するために、
Sub test002()
Dim y As Integer 'ループのカウンター
y = 10 '10行目から
While Cells(y, "B") <> "" 'B列に何か入っている間ループ
Debug.Print Cells(y, "B") 'B列をテスト表示
y = y + 1
Wend
End Sub |
と、B列に何か入っている間のループを作る人も居ます。
固定のときはForで可変の時はWhileやDo loopを使う人多いですね。
まぁ、そんな感じで、データ数分のループを作ります。
/*
* ４．受け取った都道府県名とファイル名を使用してファイルを作成する
*/
次は、受け取った都道府県名とファイル名を使用して、
実際にxxx.htmlファイルを作成してみます。
まず、メインのループは、
'メインのループ
Sub test002_main()
Dim y As Integer 'ループのカウンター
y = 10 '10行目から
While Cells(y, "B") <> "" 'B列に何か入っている間ループ
'ファイル作成のサブ関数に都道府県名とファイル名を渡す
Call test002_CreateHtmlFile(Cells(y, "B"), Cells(y, "C"))
y = y + 1
Wend
End Sub |
と、B列にデータが在る間、
B列(都道府県名)とC列(ファイル名)
を
サブ関数に渡します。
サブ関数では、受け取った名称を使用して、雛形ファイルの作成作業を行います。
'都道府県名とファイル名を受け取り、HTMLファイルを作成するサブ関数
Sub test002_CreateHtmlFile(strKEN As String, strHTML As String)
Dim strFNAME As String 'ファイル名格納用
'ブックと同じ位置にxxx.htmlを作成する
strFNAME = ThisWorkbook.Path & "\" & strHTML 'ファイル名の作成
Open strFNAME For Output As #1 'ファイル番号１で新規作成
'データ書き込み、都道府県だけ変えて作成する
Print #1, "<html>"
Print #1, "<head>"
Print #1, "<title>" & strKEN & " 宿・ホテルの予約／検索</title>"
Print #1, "</head>"
Print #1, "<body>"
Print #1, "<h1>" & strKEN & " 宿・ホテルの予約／検索</h1>"
Print #1, strKEN & "の宿・ホテルの予約や検索サイトをまとめています。<br>"
Print #1, "クリックして探してみてください<br>"
Print #1, ""
Print #1, "あとでここにバナー広告をここに貼る。<br>"
Print #1, ""
Print #1, "</body>"
Print #1, "</html>"
Close #1 '開いたら閉じようね
End Sub |
うわっ、芸無くPrint #で縦に羅列したの・・・ぷっ。
笑わないでよ。とっかかりなんだからさ・・・
/*
* ５．終わりの挨拶
*/
今回のサンプル、
http://www.ken3.org/vba/lzh/vba165.lzh
に保存しました。
解凍して都道府県.xlsを開いて、
内容を変えたりして、遊んでください。
パラメータでファイル名と内容を渡し、
テキストファイル(HTML)を作成してみました。
でも、なんか、しっくり来ないし、変更が大変だよねこれでは・・・
次回は、変更しやすい作り方にチャレンジかな。
何か読者の心に残れば、うれしいです。
＊私の独り言をうまく消化してくださいね。
いつも狙いが違うだろ？三流プログラマー Ｋｅｎ３でした。
＜Excel VBA シートをテキストファイルに保存＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
少々の小細工 =B2 & "文字列"とセルに計算式を入れ、
シートを作成します。
そのシートをテキスト保存(名前を.html)してみます。
/*
* １．今回のキッカケ
*/
前回、
ループで都道府県データを回し、
下記のようなPrint #の羅列でテキストファイルを作成しました。
'データ書き込み、都道府県だけ変えて作成する
Print #1, "<html>"
Print #1, "<head>"
Print #1, "<title>" & strKEN & " 宿・ホテルの予約／検索</title>"
Print #1, "</head>"
・
・
・
すると、読者の心の中からクレームが（実際下記のようなクレームは来てないけど）
あのう〜言いにくいんですが、私の上司や同僚はVBAなんて知らないんです。
そうですか、アナタしかＶＢＡを触れない、ＶＢＡなんて知らない、
普通の会社の話ですよね。
（自分ができるからって、みんなができると思うなボケ!!）
雛型を修正する時、alt+F11でVBAの編集画面を開いて、
Print #1, ""の中を修正してと同僚に言ってもたぶんムリです。
結局マスターからのhtml作成作業、誰でもできるようにVBAを作ったつもりが、
修正するのは自分なんてことになりそうです。
これだったら、隣で携帯メールを仕事中に打っている人でもできる、
ファイルをコピーして中身をメモ帳で修正してもらうほうが、私の作業は減ります。
ギク、、確かにＶＢＡでマクロ組んで楽したつもりが、
自分が専任作業者になってしまう、そんなこともありますね・・・
ありますねジャねぇダロ！！コラ、もっと簡単に修正可能にしろよプロだろ。
はぁ、まいったまいった。
-- 余談 逆の専任者を喜ぶ人も居るよ --
誰でもできる（誰でも操作可能な）システムがいいって話だったけど、
人って面白いもので、アナタしかできない、専任者しか動かせないってのを
喜ぶ担当者も居るんだよ。
まったくオレ様が居ないと伝票も発行できないのか、連休とれねえなぁ
と楽しそうに話しているコンピュータ操作が得意なおじさん、意外と多いよ。
まぁ、本題は誰でもできるシステムがいいってことだけど。
誰でもいいのよ と 女性に言われつづけている私も、
アナタじゃなきゃダメと言われてみたいよね（オイオイ話がつながってないよ）
おっと、余談が長いですね。
--
今回は、少し工夫して、シートをマスター的に使って、
そのシートをテキストファイルにしてみたいと思います。
/*
* ２．VBAの修正が難しい、それならシートを修正させる
*/
マクロは自信なくても、
Excelは得意って人 や 謙虚にExcelの操作ならできます、
そんな社員さんやアルバイトさんが多いと思います。
さすがに、””の中身を修正するだけと言っても、
プログラムを作業者に修正してもらうのは社内の技術担当者として抵抗ありますよね。
そこで、シートを修正してもらう、そんな方式に変えます。
MENU と DATA 2つのシートを作成します。
MENUシートには、
これまでと同様に、都道府県などのマスターデータを置きます。
それと、マクロの起動ボタンを置きます。
DATAシートには、
出力したいHTMLの雛型を書きます。
ここで、１つ細工してほしいのが、
Menu!$B$2 に 動的に変化する都道府県を入れる枠を作ります。
そして、DATAシートでは、="<title>" & Menu!$B$2 & " 旅行〜</title>"
と、MENUシートのB2を参照してデータが変わるようにします。
↓作成したMENUシートのイメージ
↓作成したDATAシートのイメージ
↑
文字列として、シートに作成します。
<html>
<head>
="<title>" &MENU!$B$2 & " 宿・ホテルの予約／検索</title>"
</head>
<body>
="<h1>" & MENU!$B$2&" 宿・ホテルの予約／検索</h1>"
=MENU!$B$2&"の宿・ホテルの予約や検索サイトをまとめています<br>"
クリックして探してみてください<br>
あとでここにバナー広告をここに貼る。<br>
</body>
</html>
/*
* ３．仕込みは終了、シート(A列)を書き出す
*/
MENUのB2に入れた名称で、DATAシート上にHTMLの文章が作成されてます。
あとは、シートをファイルにすればいいので、
'メインのループ
Sub test003_main()
Dim y As Integer 'ループのカウンター
y = 10 '10行目から
While Cells(y, "B") <> "" 'B列に何か入っている間ループ
'ファイル作成のサブ関数に都道府県名とファイル名を渡す
Call test003_CreateHtmlFile(Cells(y, "B"), Cells(y, "C"))
y = y + 1
Wend
MsgBox "作成が終了しましたデータを確認してください"
End Sub |
↑は、前回と同様で都道府県名とファイル名を下のサブ関数に渡してます。
'都道府県名とファイル名を受け取り、HTMLファイルを作成するサブ関数
Sub test003_CreateHtmlFile(strKEN As String, strHTML As String)
Dim strFNAME As String 'ファイル名格納用
'処理する値をB2にセットする B2に県名をセットする
Sheets("MENU").Range("B2") = strKEN
'ブックと同じ位置にxxx.htmlを作成する
strFNAME = ThisWorkbook.Path & "\" & strHTML 'ファイル名の作成
Open strFNAME For Output As #1 'ファイル番号１で新規作成
'データ書き込み、DATAシートの</html>まで
Dim y As Integer
For y = 1 To 999 '最大999行まで
Print #1, Sheets("DATA").Cells(y, "A")
'書き込みの終了判断を</htmlで行う>
If Sheets("DATA").Cells(y, "A") = "</html>" Then
Exit For 'ループを抜ける
End If
Next y
Close #1 '開いたら閉じようね
End Sub |
MENUシートのB2にデータをセット後、
単純に、DATAシートのA列を書き出してます。
これで、DATAシートを直せば雛型ファイルを
誰でも大量生産できそうです。
^^^^^^
プログラムとデータを切り離す、基本といえば基本なんだけど、
やはり直でPrint #1, "出力データ"と書いてしまったりします。
自分にしかできないプログラム修正もいいけど、
みんなが修正できるシステムも作ってみては？
/*
* ４．シートをTEXTにする方法をマクロ記録で探る
*/
で、終了してしまうと、面白くないので、
シートをテキストファイルに保存するマクロを探ってみます。
普通に手で操作すると、あれ？
選択したファイルの種類は複数のシートを含むブックをサポートしていません。
と警告が、まぁＯＫ押すと保存されるけど。
↑警告メッセージ
そしたら、
・シートのコピー、新規ブック
・そのシートをテキストタブ区切りで保存
・シートを閉じる
といった流れにするか。
記録すると下記のようになりました。
Sub Macro1()
Sheets("DATA").Select
Sheets("DATA").Copy
ActiveWorkbook.SaveAs Filename:="E:\広告旅行\aaa.html", FileFormat:=xlText, _
CreateBackup:=False
ActiveWorkbook.Close
End Sub |
このままだと、２回目走らせた時に上書確認のメッセージが出るので、
↑上書き確認メッセージ
該当ファイルをKillで消してから、新規に上書きしてみます。
そして.Closeで閉じたときも確認メッセージをキャンセルしてみます。
'都道府県名とファイル名を受け取り、HTMLファイルを作成するサブ関数
Sub test004_CreateHtmlFile(strKEN As String, strHTML As String)
Dim strFNAME As String 'ファイル名格納用
'処理する値をB2にセットする B2に県名をセットする
Sheets("MENU").Range("B2") = strKEN
'ブックと同じ位置にxxx.htmlを作成したいので
strFNAME = ThisWorkbook.Path & "\" & strHTML 'ファイル名の作成
'ファイルが既にあったら消す
If Dir(strFNAME) <> "" Then
Kill strFNAME 'Killステートメントでファイルを消す
End If
'データシートをコピーして新規ブックが作られる
Sheets("DATA").Copy
'テキスト形式FxlTextで保存する
ActiveWorkbook.SaveAs Filename:=strFNAME, FileFormat:=xlText
'保存の確認をしないで終了
ActiveWorkbook.Close SaveChanges:=False
End Sub |
実行すると、画面がチカチカするけど、まぁ、なんとかできました。
んっ？この方法だったら、初めから自分でテキストファイル作らないで、
保存のファイルフォーマットをFileFormat:=xlTextと指定すればよかったってこと？
まぁ、同じ処理でも処理方法はいっぱいあるってことで・・・
/*
* ５．終わりの挨拶
*/
今回のサンプル、
http://www.ken3.org/vba/lzh/vba166.lzh
に保存しました。
解凍して都道府県.xlsを開いて、
内容を変えたりして、遊んでください。
ポイントは、
別シートに雛型を作り、データを切り替える(貼りかえる)ことで処理しました。
あとは、データとプログラムを切り離す参考、
同じ動作でも、自分でループで回す書き方
と
シートコピー後、ファイルの記録フォーマットを変えるExcel標準関数で処理、
なんて感じで、いろいろあるんだなぁと感じとってもらえれば
何か読者の心に残れば、うれしいです。
＊私の独り言をうまく消化してくださいね。
三流プログラマー Ｋｅｎ３でした。
＜amazonの広告コード UTF-8を探る(keywordを作る)＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
本の通信販売、amazon.comで使用している、
UTF-8のkeywordコードを作ってみたいと思います。
/*
* １．今回のキッカケ
*/
前回、都道府県別のhtmlファイルを作成しました。
目的は、旅行の広告ページを作ることです。
そこで、旅行の申し込み広告の下にガイドブックの広告を表示して、
ガイドブックをついでに買ってもらう
or
旅行の申し込み無くても興味あるターゲットに本を売ろう
と考えました。
本の通信販売、有名なamazon.comでキーワードリンクがあるので、
神奈川ガイドと都道府県にガイドを付けてキーワードにしてみたいと思います。
手作業で作ると、
keyword=%E7%A5%9E%E5%A5%88%E5%B7%9D+%E3%82%AC%E3%82%A4%E3%83%89&mode=blended
となり、keywordに%E7%A5%9E%E5%A5%88%E5%B7%9Dなど、コードが指定されています。
このコードが聞き慣れないUTF-8のコードです。
/*
* ２．UTF-8のデータ構造を調べてみた
*/
ASP系のメルマガとかぶってしまうのですが（流用なのですが、）
http://www.ken3.org/cgi-bin/cnt/log100.asp
で、リンク元などを確認してます。
リンク元をみてみると、googleからの検索で
http://www.google.co.jp/search?q=%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB
などのkeywordコードが保存されてます。
q=が検索文字列だと思うのですが、
%E3 %83 %95ってなんだ？どうしても変換方法が見つかりませんでした
また、別のログデータからコード体系らしい部分を見ると、
ie=utf8&oe=utf8&querytime=8TuE&
このUTF8ってのが怪しそうです。
何を見たか？下記のようなコードの表を見ました。
http://www.asahi-net.or.jp/~CI5M-NMR/w3/rfc2279.txt
より
UCS-4 range (hex.) UTF-8 octet sequence (binary)
0000 0000-0000 007F 0xxxxxxx
0000 0080-0000 07FF 110xxxxx 10xxxxxx
0000 0800-0000 FFFF 1110xxxx 10xxxxxx 10xxxxxx
0001 0000-001F FFFF 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
0020 0000-03FF FFFF 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
0400 0000-7FFF FFFF 1111110x 10xxxxxx ... 10xxxxxx
と、変換表(規則)が書いてあった。
※binaryの単語で引っかかったと思う。
これを見て、手で変換してみた。
http://www.google.co.jp/search?q=%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB
が検索単語の ファイル を指定してます。
%E3%83%95 フ
%E3%82%A1 ァ
%E3%82%A4 イ
%E3%83%AB ル
とUTF-8でコード付けされてます。
ファイルの[フ]がE3 83 95かぁこれを２進数に直すと。
E 3 8 3 9 5
1110 0011 1000 0011 1001 0101
となります。
ここから、
0000 0800-0000 FFFF 1110xxxx 10xxxxxx 10xxxxxx
の規則でxxxxの実データを取り出すと(1110 10 10は固定のコードなので)
E 3 8 3 9 5
1110 0011 1000 0011 1001 0101
xxxx xx xxxx xx xxxx
から xの部分を取り出すと、
0011 00 0011 01 0101
となり、わかりやすく、
0011 0000 1101 0101
として16進に直すと
30D5となるが、これはUNICODEらしい。
これをシフトJISから変換できれば、
UTF-8のデータを作り出せそうです。
※SJISとUTF-8のやり取りができそうです。
/*
* ３．UNICODEと言われてもなぁ ASCW関数で単純に変換してみた
*/
UNICODEと言われてもなぁ、どうやって変換するんだろう？
悩んでいたら、ASCWとCHRWがUnicode コード ポイントをやり取りするみたいです。
ASCとASCW関数
http://www.microsoft.com/japan/msdn/library/ja/vblr7/html/vafctasc.asp
CHRとCHRW関数
http://www.microsoft.com/japan/msdn/library/ja/vblr7/html/vafctchr.asp
に書いてありました。
ASC関数とASCW関数の違いを見るために、
下記の確認プログラムをASPのVBScriptで作ってみました。
単純にASCとASCWで変換しただけですが。
三流君ASPを変換すると、下記でテストすると、
http://www.ken3.org/cgi-bin/test/test097-1.asp?DATA=%8EO%97%AC%8CNASP
n文字目 調査する文字 ASC結果(16進) ASCW結果(16進)
1 三 8E4F 4E09
2 流 97AC 6D41
3 君 8C4E 541B
と変換されます。
おっと、確認したいのは、ファイルのフのユニコードだった、
http://www.ken3.org/cgi-bin/test/test097-1.asp?DATA=%83t%83@%83C%83%8B
で確認すると、
n文字目 調査する文字 ASC結果(16進) ASCW結果(16進)
1 フ 8374 30D5
2 ァ 8340 30A1
3 イ 8343 30A4
4 ル 838B 30EB
と表示されました。
30D5のコードにやっとたどり着きました。
/*
* ４．SJISをUTF-8に直す
*/
さてと、
では、本題の何も意識しないで使用しているシフトJISをUTF-8に直してみます。
SJISをASCW関数でUNICODEに変換してから、
そのコードを２進数に直す。
２進数を固定のビットを立てたコードに当てはめて、
再び１６進数に戻す。そのとき%を付けた文字列にする。
なんか、かったるいけど、チャレンジしてみます。
ASP VBScriptで作ったサンプルは、下記のサンプルです。
儲かる http://www.ken3.org/cgi-bin/test/test097-3.asp?DATA=%96%D7%82%A9%82%E9
娘。 http://www.ken3.org/cgi-bin/test/test097-3.asp?DATA=%96%BA%81B
転職 http://www.ken3.org/cgi-bin/test/test097-3.asp?DATA=%93%5D%90E
で、終わるとさびしいので、VBAのファイル作成処理に追加してみます。
ソースは長いけど、
下記のような感じです。
ポイントは、ASCWでUNICODEにして、２進数に変換後、
変換した１６ビットを
'xxxx xxxx xxxx xxxx を下記に割り当てる
'1110xxxx 10xxxxxx 10xxxxxx
と、指定位置に割り当てただけです。
Function MAKE_AMAZON_KEYWORD(strMOTO As String)
Dim n As Integer
Dim strRET As String
Dim strCHK As String
Dim strCODE As String
Dim strUNICODE As String
Dim strUTF8 As String
strRET = "" 'リターン値を初期化する
For n = 1 To Len(strMOTO)
strCHK = Mid(strMOTO, n, 1) '一文字取り出す
strCODE = Hex(Asc(strCHK)) 'その文字コードを16進文字列にする
If Len(strCODE) <= 2 Then '半角か？
If Asc(strCHK) <= &H20 Then
'制御コードか？
strRET = strRET & "%" & Right("0" & strCODE, 2)
Else
'英数はそのまま＋する
strRET = strRET & strCHK
End If
Else '全角文字の時は、UTF-8にする
strUNICODE = Hex(AscW(strCHK)) 'まずUNICODEに変換する
strUTF8 = UNItoUTF8(strUNICODE) '次にUNICODEをUTF8に変換する
'%を付けて格納
strRET = strRET & "%" & Mid(strUTF8, 1, 2)
strRET = strRET & "%" & Mid(strUTF8, 3, 2)
strRET = strRET & "%" & Mid(strUTF8, 5, 2)
End If
Next n
'リターン値をセットして終わる
MAKE_AMAZON_KEYWORD = strRET
End Function |
'UNIコードの文字列を受け取り、UTF-8コードの文字列を返す(%付けない)
Function UNItoUTF8(strUNICODE As String) As String
Dim strWORK As String
Dim strUTF8 As String
'JISコードを２進にする
strWORK = HEX16toSTR2(strUNICODE)
'切り取って、UTF8の２進数を作成する
'xxxx xxxx xxxx xxxx を下記に割り当てる
'1110xxxx 10xxxxxx 10xxxxxx
strUTF8 = "1110" & Mid(strWORK, 1, 4)
strUTF8 = strUTF8 & "10" & Mid(strWORK, 5, 6)
strUTF8 = strUTF8 & "10" & Mid(strWORK, 11, 6)
'作成した２進数を１６進数文字列に再度戻してリターン値とする
UNItoUTF8 = STR2toHEX16(strUTF8)
End Function |
'HEX16進文字列を受け取り２進文字列を返す
Function HEX16toSTR2(strHEX As String) As String
Dim n As Integer 'ループカウンタ
Dim i As Integer 'ループのカウンタ
Dim n8421 As Integer '8 4 2 1の数値計算用
Dim str2STR As String
Dim nCHK As Integer
str2STR = "" '結果のエリアを初期化する
'文字数分ループする
For n = 1 To Len(strHEX)
nCHK = CInt("&h" & Mid(strHEX, n, 1)) 'n文字目を数値変換
n8421 = 8 '初期値に８を代入する(上からチェックしたいので)
For i = 1 To 4 '４回まわるよ
If (nCHK And n8421) = 0 Then 'Andでビットをチェックする
str2STR = str2STR & "0" 'ビットは立ってないよ
Else
str2STR = str2STR & "1" 'ビットは立ってるよ
End If
'次のビットをチェックしたいので２で割る
n8421 = n8421 / 2
Next i
Next n
'リターン値をセットして終了
HEX16toSTR2 = str2STR
End Function |
'2進文字列を受け取り16進文字列を返す
Function STR2toHEX16(ByVal str2 As String) As String
Dim strHEX As String
Dim n As Integer 'ループカウンタ
Dim i As Integer 'ループのカウンタ
Dim n8421 As Integer '8 4 2 1の数値計算用
Dim nBYTE As Integer
'頭４文字単位かチェックする
n = Len(str2) Mod 4 '足りない文字数を計算する
If n <> 0 Then
str2 = String(4 - n, "0") & str2 '頭に文字０を追加する
End If
strHEX = "" '結果のエリアを初期化する
'文字数分ループする
For n = 1 To Len(str2) Step 4 '４文字(1バイト)単位にループを作る
n8421 = 8 '初期値に８を代入する(上から計算したいので)
nBYTE = 0 '1バイト計算用変数を初期化
For i = 0 To 3 '４回まわるよ(4ビット分)
'ビットが立っているかチェックする
If Mid(str2, n + i, 1) = "1" Then
nBYTE = nBYTE + n8421 'ビットに対応した数値を＋する
End If
'次のビットを計算したいので２で割る
n8421 = n8421 / 2
Next i
'計算して、１倍との数値が完成したので１６進文字にしてセットする
strHEX = strHEX & Hex(nBYTE)
Next n
'リターン値をセットして関数を抜ける
STR2toHEX16 = strHEX
End Function |
テストで、
? MAKE_AMAZON_KEYWORD("神奈川")
%E7%A5%9E%E5%A5%88%E5%B7%9D
と変換できました。
簡単な確認方法は、googleのq=とパラメータを追加して確認します。
※実際に送ってみて確認する方法です。
http://www.google.co.jp/search?q=%E7%A5%9E%E5%A5%88%E5%B7%9D&hl=ja&ie=UTF-8
↑で、無事、神奈川のキーワードが渡ったと思います。
あとは、アマゾンのキーワード、URLに埋め込んで完成です。
※アマゾンの広告コードメルマガに載せるとはじかれるので、
ソースはカットしてます。
/*
* ５．終わりの挨拶
*/
今回のサンプル、
http://www.ken3.org/vba/lzh/vba167.lzh
に保存しました。
解凍して都道府県.xlsを開いて、
内容を変えたりして、遊んでください。
何か読者の心に残れば、うれしいです。
＊私の独り言をうまく消化してくださいね。
三流プログラマー Ｋｅｎ３でした。
＜詳細な設計って？＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、よく、メールで問い合わせを受ける
詳細設計について、乱暴に書いてみます。
詳細設計のイロハではないので、一部拾い読みをしてください。
※三流プログラマーに文句を言いながら読むのが正しい読み方です。
/*
* １. 今回のキッカケ
*/
あるいいかげんな上司や先輩から、
下記のように簡単な機能概要と画面のラフ書きをもらいました。
目的：フォーム上にWebのデータを表示する。
・URL を 入力することができるようにする。
・出力するweb上のテーブルを選択可能とする
・出力するExcelシートを選択可能とする。
↑オイオイ、これが要求仕様か？かんべんしてよ、目的と３行のみかよ。
ここから、お客さんのやりたいことを読み取るの？
※要求仕様のまとめ方もネタになりそうだけど、今回はパス。
画面イメージ:
URL [ ________________________ ]
↑現在のURLを表示、入力修正後はそのページへ切り替える
Webの画面を表示する。
・
・ ※ユーザーが自由にクリックしたりできる
・
Webの画面を表示する。
TABLE ブック シート
[ ] [新規 ] [新規 ]
[ ] [aaa.xls ] [ ]
[ ] [bbb.xls ] [ ]
[ ] [ccc.xls ] [ ]
↑リストボックス
と選択可能とする。
_____________
|EXCELへ出力|
~~~~~~~~~~~~~
/*
* ２．こんなの設計じゃないよ 何が足りないか？
*/
さて、こんな紙切れ１枚渡されて、あなたはプログラムを作れますか？
作れないですよね。
設計者と製作者が一緒だから、頭の中でまとまってますが、
これが通常の開発で、設計と作成が違うと、まずいですよね。
私の中でわかってますが、読者やもしお願いする担当者にこれを渡しても
？？？だと思います。
何が足りないか？
全てです、出直して来い or オレも打ち合わせに同行させろ
と言いたいですが、少し冷静になって、
細かい話をすると、
コントロールの名前
~~~~~~~~~~~~~~~~~~
が
画面設計に無い。（名前ぐらい自由に付けたいといった担当者も居ますが）
^^^^^^^^^^^^^^^
※コーディング規則が社内にある会社と無い会社によって違ったり、
先輩の趣味、自分のこだわりとか、これもネタになるんだけど。。。
コントロール名、日本語だけは止めてねと言われたことあったり。
私が日本語のコントロール名が好きな話は置いといて、
動作が不明、詳細が書いていない。
^^^^^^^^^^^~~~~~~~~~
言葉で少し説明があるが、動作イメージが書いていない、
これでは、処理が伝わっていないので目的と違うプログラムを作成してしまいます。
そこで、少し修正しました。
URL [ ________________________ ] (txtURL)
↑現在のURLを表示、入力修正後はそのページへ切り替える
Webの画面を表示するエリア (AxWebBrowser1)
・
・ ※ユーザーが自由にクリックしたりできる
・
Webの画面を表示する。
TABLE ブック シート
[ ] [新規 ] [新規 ]
[ ] [aaa.xls ] [ ]
[ ] [bbb.xls ] [ ]
[ ] [ccc.xls ] [ ]
(lstWEBTABLE) (lstBOOK) (lstSHEETS)
↑リストボックス
_____________
|EXCELへ出力| (btnTOEXCEL)
~~~~~~~~~~~~~
()はコントロール名とします。
これで、使用するコントロールのイメージが画面に付きました。
次は、必要ないけど行数稼ぎでコントロール一覧を付けてもイイですね。
名称 種類 備考
txtURL テキストボックス
AxWebBrowser1 WebBrowser IEのコントロール、別DLL参照
lstWEBTABLE リストボックス
lstBOOK リストボックス
lstSHEETS リストボックス
btnTOEXCEL ボタン
あまり、一覧とかこだわると、
じゃ文字表示にしか表示ラベルも一覧に載せるのか？
と
極論を言われるけど、意味無いのは載せないでＯＫでしょう。
※ラベルのコントロール名まで書いていたら、その先輩はある意味怖かったり。。。
一緒には仕事したくない、そんな細かさも時には必要だったりするんだけど。
次に、コントロールに対しての処理でしょう。
処理＝イベント、タイミングと読み替えてもＯＫかなぁ。
~~~~~~~~~~~~~~~~~~~~~~~~~~
フォームが読み込まれたら、初期ページを表示する
通常実際にコードは書かないけど、こんな感じで書いてあれば、
_Loadのイベントに、初期ページのコードを書けばいいんだぁ
Private Sub Form1_Load( _
ByVal sender As System.Object, _
ByVal e As System.EventArgs _
) Handles MyBase.Load
'フォーム読み込みと同時に、初期ページを表示する
Me.Me.AxWebBrowser1.GoHome() '初期ページに移動する
End Sub |
※vb.netのサンプルです
と、プログラマーさんは、わかるかな。
同様に、イベント、タイミング別に処理を書きます。
※設計時に書き漏れとかあるんだけど、そこはご愛嬌、人間関係で（オイオイ）
間違っても、
こんなこともわからないのか小僧は？ vs まともなに設計しろ高給取りの課長様
なんて関係にならないで、先輩の設計の不備を補ってあげたり、
後輩が聞きにきたら、丁寧に説明しましょうね。
コントロール名：txtURL テキストボックス
ユーザーがURL入力後、コントロールがフォーカスを失ったら、
入力されたＵＲＬにジャンプする(AxWebBrowser1を操作)
コントロール名：AxWebBrowser1 WebBrowser
読み込み完了後のイベントで、
移動後表示されたURLをtxtURLにセット
lstWEBTABLEをクリアし、
ドキュメントからlstWEBTABLEへテーブル名をセットする。
※テーブル名が無い場合は連番にする
lstBOOK,lstSHEETS,btnTOEXCELを使用不可にする
コントロール名：lstWEBTABLE リストボックス
テーブルが選択されたら、
lstBOOKをクリアし、新規ブックの固定文字を一番上にセット
lstBOOKを使用可能にする
起動されているExcelオブジェクトを探し、lstBOOKにブック名をセットする。
コントロール名：lstBOOK リストボックス
リスト内が選択されたら、
新規ブックだったら、lstSHEETSに新規シートをセット、使用可能にして抜ける
選択されたブック内のシートを探し、lstSHEETSにリストアップする(.addする)
コントロール名：lstSHEETS リストボックス
リスト内のシートが選択されたら、Excel出力ボタン(btnTOEXCEL)を使用可能とする
コントロール名：btnTOEXCEL ボタン
確認メッセージを表示して
選択されたテーブル(lstWEBTABLE)のデータを
lstBOOK,lstSHEETSへ出力する。
と、ここまで、行数を使って書きましたが、
まだまだ足りなかったりします。
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
えっ、これ以上書くと設計者がコーディングしているようなもの？
まぁ、それくらい書いておくと、意思の疎通がうまくいくかなぁ。
※実は、設計した時点で、できている、
そんな設計ならバグも少なかったりするんだけど
手を抜き過ぎて、設計やらないで作り始めると(渡すと)
痛い目にあったり・・・・
/*
* ３．終わりの挨拶
*/
どんな情報があれば、プログラムを作り始められるか・・・
意外と奥が深かったりします。
単純な画面１枚を作成するだけなら、名前と動きだけでいいけど、
全体的なデータの流れ、DBの入出力なども、必要になってきます。
今回は、
オブジェクト と イベントが書いてあれば、わかりやすい、
そんな話でした。
あまり、テクニック的なネタじゃないのですが、
何か、感じ取ってくれると、うれしいです。
ＡＢ型の変わり者、三流プログラマーのＫｅｎ３でした。
＜Outlookで複数のファイルを添付するには？＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
Outlookで*.xlsなど、複数のファイルを添付する、
そんな処理にチャレンジしてみたいと思います。
/*
* １. 今回のキッカケ
*/
No.078 Outlookでファイルを添付するには？.Attachments.Add
http://www.ken3.org/vba/backno/vba078.html
からもらった質問。
---
>ご紹介頂いた添付の自動処理ですが、添付するファイルが常に同じフォルダ
>にあって、ファイル名はその日によって異なるが拡張子だけは常に同じとい
>う場合、ワイルドカードって使えるんでしょうか？
>例えばC:\My Documents 内にあるエクセルファイルを添付したい場合、
>
>objMAIL.Attachments.Add "C:\My Documents\"*.xls""
>
>として試してみたら構文エラーと表示されてしまいます。
---
と質問をもらった。
う〜ん・・・どうしましょ・・・
>objMAIL.Attachments.Add "C:\My Documents\"*.xls""
で複数ファイルを添付したいかぁ・・・
/*
* ２．勝手に仕様や考え方を変える
*/
上司や先輩が作った動作仕様を勝手に変えると、
動いたり、いい処理を作っても怒られてしまうこともあるのだが、
（※相手のプライドを立てながら・・政治的に動くプログラマーって...イヤだけど）
なんて話は、置いといて、
原因は、
>objMAIL.Attachments.Add "C:\My Documents\"*.xls""
で複数ファイルを添付できない
ならば、１つ１つバラバラで添付してみますか。
※１つ１つの連続が複数ってことで
/*
* ３．ファイル名を取得する方法でDir関数を使う
*/
とすると、知りたいのは少し変わって、
C:\My Documents\*.xls
このファイル名を取得したいよね。
そんな時に使うのがDir関数です。(※他にもあるけど今回はこれで)
Sub aaa()
'マイドキュメントの*.xlsファイル名をMSGBOXで表示する
Dim strBASEPATH As String
Dim strFILETYPE As String
Dim strFileName As String
'strBASEPATH = "C:\My Documents\" '調べたい場所
strBASEPATH = "C:\Documents and Settings\user2000\My Documents\"
strFILETYPE = "*.xls" 'マッチングパターン
'DIR関数にC:\My Documents\*.xlsみたいにワイルドカード付きを渡す
strFileName = Dir(strBASEPATH & strFILETYPE)
'↑すると、一番最初の名前が返ってくる(順不同)
'名前がなくなるまでループ
While strFileName <> "" 'ファイル名が""空文字以外の間ループする
'ファイル名を使って処理を行う
MsgBox "ファイル名は" & strFileName & "です"
'いろいろな処理を行う
'↑と１つのファイルの処理が終わったら、次の名前を取り出します
'↓次の名前の処理に移るには、Dir関数を引数無しで呼び出します
strFileName = Dir '←不思議だがこの引数無しで次のパターンを取り出せる
Wend
'↑こんな感じでループを作って１つ１つファイルを処理してみました。
End Sub |
基本の作りは、
ファイル名=Dir("ファイルの場所＋*.xlsなどのパターン",ファイルの種類(省略化))
ではじめにC:\My Documents\*.xlsみたいにワイルドカード付きを渡す
すると、ファイル名が返ってくるので、
あとはループで、
While ファイル名が空になるまで(ファイル名で無い間)
ファイル名がわかるのでファイルに対して処理を行う
処理したよ
処理が終了したら、次のファイル名に進まなきゃ
strFileName = Dir '←＊１不思議だがこの引数無しで次のパターンを取り出せる
Wend ループの先頭へ
ポイントはDir関数を引数無しで呼ぶことかな。＊１
/*
* ４．添付ファイルを繰り返しセットしてみた
*/
Dir関数でのテストが終了したら、
複数ファイルを添付する、そんなテストプログラムを作成してみます。
Sub testSEND送信()
Dim oApp As Object 'アプリケーションオブジェクト
Dim objMAIL As Object 'メールのオブジェクト
Dim strMOJI As String '本文
'アプリケーションオブジェクトの作成
Set oApp = CreateObject("Outlook.Application")
Set objMAIL = oApp.CreateItem(0) 'olMailItem=0
strMOJI = "こんにちは" & vbCrLf _
& "資料を送ります、" & vbCrLf _
& "よろしくお願いします"
objMAIL.To = "test@ken3.org" '宛先
objMAIL.Subject = "未承諾広告※（笑）" '件名
objMAIL.Body = strMOJI '本文の代入
'ここでファイル数分 添付ファイルを＋する処理を行う
Dim strBASEPATH As String
Dim strFILETYPE As String
Dim strFileName As String
'strBASEPATH = "C:\My Documents\" '調べたい場所
strBASEPATH = "C:\Documents and Settings\user2000\My Documents\"
strFILETYPE = "*.xls" 'マッチングパターン
strFileName = Dir(strBASEPATH & strFILETYPE) 'DIR関数にPATH+*.xlsを渡す
'↑すると、一番最初の名前が返ってくる(順不同)
'名前がなくなるまでループ
While strFileName <> "" 'ファイル名が""空文字以外の間ループする
'ファイル名を使って処理を行う
'↓１つ1つ添付する ↓↓パス＋ファイル名を渡す
objMAIL.Attachments.Add strBASEPATH & strFileName
'↓次の名前の処理に移るには、Dir関数を引数無しで呼び出します
strFileName = Dir '←引数無しで次のパターンを取り出せる
Wend
'↑こんな感じでループを作って１つ１つファイルを処理してみました。
objMAIL.Display '編集メッセージの表示 .Sendから変更
'おまけでＯｕｔｌｏｏｋ表示
Dim myNameSpace As Object
Dim myFolder As Object
Set myNameSpace = oApp.GetNameSpace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダーを指定
myFolder.Display '表示
End Sub |
チョット、ぐちゃぐちゃしてますが、こんな感じで複数無事に添付できたと思います。
/*
* ５．終わりの挨拶
*/
今回は、
Dir関数を使用して、*.xlsのファイル名を取り出す。
その取り出した複数ファイルをOutlookで添付してみた。
そんな話でした。
三流君VBAでOutlookを操作する
http://www.ken3.org/cgi-bin/group/vba_outlook.asp
↑にVBA Outlook系のメルマガまとめてます、こちらも一口どうぞ。
全体的に斬新なテクニック系のネタじゃないのですが、
何か、感じ取ってくれると、うれしいです。
ＡＢ型の変わり者、三流プログラマーのＫｅｎ３でした。
検索して目的の情報を探す。
目的の情報を探すには、最近はググれとよく聞きます。なので、検索ボックスを付けました。
いろいろなキーワードを入れて、検索してみてください。
ページフッター
ここまで、読んでいただきどうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。
質問や要望など メッセージを送る(三流君に連絡する)
質問や要望など連絡方法でお互い確認が取りやすく、便利なのが掲示板なのですが、私の対応のまずさから不定期で荒れてしまい、掲示板は現在封鎖中です。(反省しなきゃ)
|
|
感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。
|
急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。
リンクや広告など
項目別に↓に人気の記事をまとめてみました。お探しのジャンルを選択してください。
人気記事(来場者が多い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系バックナンバー目次へ移動]
