三流君 ＶＢＡで楽しくプログラミング(Excel/Access VBAの解説/サンプルです)
[VBA系のバックナンバー]
[質問/感想 掲示板]
[メルマガ登録/解除]
[VBA系 TOP]
[サイトマップ]
＜空のMDBを作成後、DoCmd.CopyObjectでテーブルコピー＞
こんにちは、三流プログラマーＫｅｎ３です。
今回は、
Access2000〜でADOを使用した、
空のＭＤＢ作成方法
と
DoCmd.CopyObjectでテーブルコピー
です。
/*
* １．今回のキッカケ
*/
下記の質問メールをもらいました。
----
In message "やばいです。",
m*****さん wrote...
>テーブルのバックアップ用ボタンを作成したのですが
>
>Private Sub バックアップ_Click()
> If MsgBox("テーブルデータをバックアップしますか？", _
> vbYesNo + vbQuestion) = vbYes Then
> DoCmd.CopyObject "c:\Back\試作.mdb", , acTable, "指示書表紙テーブル"
> ~~~~~~~~ ~~~~~~~~~~~~~~~~~~
> ↑ファイル名 ↑テーブル名
>
> End If
>End Sub
>
>
>サブテーブル「指示内容テーブルサブ」も一緒にCopyさせたいのですが
>テーブル名が１つしか入りません。
>複数のテーブル名を指定するのは無理なのでしょうか？
>
>それから
>指定したフォルダー内にあらかじめコピー先のデータベースを作成しておかないと
>エラーが出てコピーできませんでした。(T◇T)
>フォルダー指定だけではダメですか？
----
勝手な想像、人様の苦労の流れをいつものように想像（創造）
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
複数のテーブルをデータごとバックアップしたい。
いろいろと自分なりに調べ、
DoCmd.CopyObject "c:\Back\試作.mdb", , acTable, "指示書表紙テーブル"
で、テーブルがコピーできることを発見する。
ここまでは順調だったが、
空のＭＤＢファイルが無いと、DoCmd.CopyObjectが動作しないことに気がつく。
また、全てのテーブルを一度にコピーするコマンドがあれば聞きたい。
ってことかなぁ。
一生懸命、物語作るのはいいけど、
質問のままの方が、わかり易くない？
気にしないでください、三流解説前の儀式？ですから（笑）
やりたいことは、なんとなく、わかったけど、
さて、どうしましょう。
そんなにスゴイ手じゃないので、期待しないでくださいね。。。
/*
* ２．空のＭＤＢファイルを作成する
*/
もう、DoCmd.CopyObjectでテーブルがコピーできることがわかっているので、
問題は、空のＭＤＢファイルを作ることだけです。
えっと、まずプログラム書く前に、
苦手な参照設定をイタズラします。
モジュールの編集画面のメニューから、
ツールの参照設定を選択します。
↑参考画面
その中から、
MicroSoft ADO Ext 2.5 for DDl〜を選択します
※ADO Ext 2.7など、環境によって違います
~~~~~~~~~~~~~~~~~
↑参考画面
ざっと書いちゃうと、
Private Sub コマンド0_Click()
Dim catTest As New ADOX.Catalog
Dim strConnect As String
Dim strDBNAME As String
strDBNAME = "D:\Backup\試作.mdb" 'バックアップ先のMdb
If MsgBox("テーブルデータをバックアップしますか？", _
vbYesNo + vbQuestion) = vbNo Then
Exit Sub 'NOの時抜ける
End If
If Dir(strDBNAME) <> "" Then 'ファイルが存在したら消す
Kill strDBNAME
End If
'データベースの新規作成
' ADOコネクション文字列の指定
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
' データベースの作成 名前を指定する
catTest.Create strConnect & strDBNAME
' データベースを閉じる
Set catTest = Nothing
'テーブルのコピーテーブル数分書くのが簡単
DoCmd.CopyObject strDBNAME, , acTable, "テーブルＡ"
DoCmd.CopyObject strDBNAME, , acTable, "テーブルＢ"
'
MsgBox strDBNAME & "にバックアップしました"
End Sub |
こんな感じです。
参照設定は
Dim catTest As New ADOX.Catalog
を使いたかったからです、実際に使うところは少し待っててもらって、
前準備から説明を開始します。
If MsgBox("テーブルデータをバックアップしますか？", _
vbYesNo + vbQuestion) = vbNo Then
Exit Sub 'NOの時抜ける
End If
普通のＹｅｓ／ＮＯの確認なんだけど、
私と違って、チャント書いてます。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
えっ、どこが？
vbYesNo + vbQuestionのとこかな。
メッセージボックスには種類があって（音と表示が違って）
vbCritical 警告メッセージ アイコンを表示します。
vbQuestion 問い合わせメッセージ アイコンを表示します。
vbExclamation 注意メッセージ アイコンを表示します。
vbInformation 情報メッセージ アイコンを表示します。
なんてのが、あったんですね。
Sub aaa()
MsgBox "XXXXX", vbYesNo + vbCritical
MsgBox "XXXXX", vbYesNo + vbQuestion
MsgBox "XXXXX", vbYesNo + vbExclamation
MsgBox "XXXXX", vbYesNo + vbInformation
End Sub |
で表示させてみると、違いがよくわかります。
×？▲ｉって感じのアイコンと音が違います。
些細な違いだけど、丁寧な仕事のシステム、
メッセージの使い分けなどは必要ですよ。
※オマエも読者の丁寧さを少しは見習えよ、、、はい。
話を戻してと、
If Dir(strDBNAME) <> "" Then 'ファイルが存在したら消す
Kill strDBNAME
End If
で、Kill ファイル名でバックアップ先のファイルを消してます。
これから新規に作成する位置にファイルが存在していると、
不具合が起きてしまうので、
Dir関数でファイルの存在をチェック後に削除してます。
次は、消したらすぐに作成する、、、忙しい行動なんだけど
本題のＭＤＢの新規作成です。
'データベースの新規作成
' ADOコネクション文字列の指定
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
' データベースの作成 名前を指定する
catTest.Create strConnect & strDBNAME
' データベースを閉じる
Set catTest = Nothing
で作成します。
後は、配列とか使わないで、力技で簡単に書くと、
'テーブルのコピーテーブル数分書くのが簡単
DoCmd.CopyObject strDBNAME, , acTable, "テーブルＡ"
DoCmd.CopyObject strDBNAME, , acTable, "テーブルＢ"
でコピーしてます。
※Ａｌｌの指定はわからなかったので、続けて書いただけのお馬鹿な書き方。
せめてループで回せよな、、、
/*
* ３．おわりの挨拶
*/
今回は、Access
・空のＭＤＢを作成する方法
・MsgBox警告、インフォなどウインドウの種類を指定してますか？
って話でした。
あっ、タイトルと内容がぜんぜん違うよ
まぁ、いつものことだからゆるしてね。。。（笑）
あっ、単純に、ＭＤＢの簡単なバックアップ方法を調べて、
解説すれば、それでよかったのかも。
最適化と組み合わせて、、など、いろいろ用途はありそうなのに。
※どこかから、簡単な技をパクって来たら、またお知らせします。
拾い読みして、
１つでも何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
※評価は↓で投票してね。感想は掲示板かメールでくださいね。
＜Access レポート Me.NextRecord = Falseで移動を止める＞
こんにちは、三流プログラマーＫｅｎ３です。
今回は、
Access レポートで、
Me.NextRecord = False
を使用して、レコードの移動を止めて見たいと思います。
メルマガの中身はふざけてる言葉が多いけど、
サンプルは真剣に作ったので、
http://www.ken3.org/vba/lzh/vba076.lzh
にtest076.mdb(Access97版)が保存されています。
テストで使ってみてください。
/*
* １．今回のキッカケ
*/
No.74 Access 列型レポートの左端に印刷したい
http://www.ken3.org/backno/backno_vba15.html#74
で、内容は、
---
> アクセスで列型のレポートを作りたいのですが、困っていることが
> あります。列型のレポートそのものは作れるのですが、ラベルがうまく
> いきません。
> 作りたいのは縦４列のデータを出力し、左端にラベルをつけるとい
> うものです。
> 詳細にラベルを置くと繰り返し出力してしまいます。結局解らなく
> て、現在はラベルと罫線と、データを分けて二重に出力するという面倒
> な方法をとっています。
> 何か解決方法はないものでしょうか？
----
列型のレポート、外枠に何か書きたい、、のかぁ、、
上下はページのヘッダー、フッターがあるけど、
左右はそれらしいの無いしなぁ。今回使いたいのは左側に何か書きたいときかぁ。
で、余白に無理やり書いて、IIfでかわしてみる方法を書いたんだけど、
やはり、印刷部分が長くて、かわせなかったみたい、う〜ん。。。
の続きです。
/*
* ２．アプローチの方法を変える
*/
さてと、余白から攻めてみても、あの子は落とせなかったかぁ。
次のアプローチ方法を考えないとなぁ。
できたら手をかけないで、女の子落としたいよね（目的を達成したいよね）
みんながやってない斬新な方法がいいけど、なかなか思いつかない。
※くだらない恋愛テクニックはネットに転がっているけど、
自分に合うテクニックが無いんだよなぁ。。。じゃなくってＶＢＡテクね。
なんて書いてると、女性読者とマジメ君が解除ボタンを押すので、
路線を戻してと、（あまり戻ってなく、いつもの三流的な文章だけど）
昔のメルマガ印刷系のサンプルで、
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Me.NextRecord = False
で、レコードを進ませないで、印刷データの複製を作ったなぁ。
※元ネタは有名な、マイクロソフトサポート技術情報の
最後まで罫線を引くで覚えたMe.NextRecord = Falseだけど。
次の構想、
^^^^^^^^^^
[1111111111] [2222222222] [3333333333] [4444444444]
[5555555555] [6666666666]
と続く印刷を
Me.NextRecord = False を使用して、
[1111111111] [1111111111] [2222222222] [3333333333]
[4444444444] [4444444444] [5555555555] [6666666666]
として、左側の重複データの時、可視のＯＮ／ＯＦＦでラベル的データを表示する。
そんな戦略で作ってみたいと思います。
※なんだ、昔の女に使った技を応用するのか？
まだ言ってるよ（スミマセン、独り言多くって（笑））
下準備、仕込みで、わかり易くするために
作成したコントロールのcntA(カウンタ)を見えるようにしてと、
(Mod 3) 3で割って余りが１の時はデータを進ませるのを止めるか。
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
If (Me![cntA] Mod 3) = 1 Then '右端なら
Me.NextRecord = False 'レコードの移動を止める
End If
End Sub |
よし、プレビューするかな。
あっ、画面全体に同じ結果が（笑）レコードが頭から動かないので（笑）
※印刷ボタンを間違って押したら、無限に印刷するので、
テスト時は注意して下さい。
そっか、
レコードが進まないから、カウンタも１のままなのか。
^^^^^^^^^^^^^^^^^^^^^^
では、フラグ使って、コントロールしますか。
Private pFLG As Boolean '印刷制御フラグ
Private Sub ページヘッダー_Format(Cancel As Integer, FormatCount As Integer)
pFLG = False '印刷してないに設定する
End Sub |
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
If (Me![cntA] Mod 3) = 1 Then '左端なら
If pFLG = False Then 'まだラベルエリアを印刷してなかったら
Me.NextRecord = False 'レコードの移動をまず止める
pFLG = True '印刷フラグを立てる
'ここにラベルのＯｎ／Ｏｆｆ処理を入れる
End If
Else
pFLG = False 'その他の時
End If
End Sub |
これで、左端のレコードだけ、２重で印刷することができました。
↑プレビュー結果
おいおい、
２重に印刷してどうするの？
~~~~~~~~~~~~~~~~~~~~~~~~~~
質問は、左端にラベルを印刷したいだろ？
まぁまぁ、あわてないでよ。
次に印刷したいラベルデータと実データの切り替えを行います。
また、=IIF使うんだろ？
それだと、芸が無いし、大変なので、
有名なプロパティ、.Visible = True/Falseを使用します。
まず、ラベルに印刷したい固定文字をレポートに貼ります
lab01,lab02とコントロール名を付けます。
可視は、Falseにしておきます
↑ラベルの配置(中身見て笑わないでね)
印刷する各コントロールに対して、
.Visible = True/Falseを使用して、印刷する／しないを切り替えます。
Private pFLG As Boolean '印刷制御フラグ
Private Sub ページヘッダー_Format(Cancel As Integer, FormatCount As Integer)
pFLG = False '印刷してないに設定する
End Sub |
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
If (Me![cntA] Mod 3) = 1 Then '左端なら
If pFLG = False Then 'まだラベルエリアを印刷してなかったら
Me.NextRecord = False 'レコードの移動をまず止める
pFLG = True '印刷フラグを立てる
'ここにラベルのＯｎ／Ｏｆｆ処理を入れる
Me![lab01].Visible = True
Me![lab02].Visible = True
'実データをＯｆｆ
Me![ID].Visible = False
Me![WrietTime].Visible = False
Me![F_TITLE].Visible = False
Me![F_MEMO].Visible = False
Else
'ここにラベルのＯｎ／Ｏｆｆ処理を入れる
Me![lab01].Visible = False
Me![lab02].Visible = False
'実データをＯｆｆ
Me![ID].Visible = True
Me![WrietTime].Visible = True
Me![F_TITLE].Visible = True
Me![F_MEMO].Visible = True
End If
Else
pFLG = False 'その他の時
End If
End Sub |
ポイントは、
Me.NextRecord = False
でレコードの移動をまず止める。
印刷対象レコードの移動の制御ができたら、次は、
左端の時は、ラベル関係を表示、実データ関係を非表示にしただけです。
~~~~~~~~~~
↑左側にラベルを無事？に表示できました。
/*
* ３.構想の穴（笑）
*/
この作戦でばっちり、女の子を落とせればいいけど
（まだ、言ってるよ、目的を達成できればいいけど）
この構想には、弱点があって、
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
[1111111111] [2222222222] [3333333333] [4444444444]
[5555555555] [6666666666]
と続く印刷を
Me.NextRecord = False を使用して、
[1111111111] [1111111111] [2222222222] [3333333333]
[4444444444] [4444444444] [5555555555] [6666666666]
として、左側の重複データの時、可視のＯＮ／ＯＦＦでラベル的データを表示
もう、気がつきました？
[1111111111] [1111111111] [2222222222] [3333333333]
が
５cm,５cm,５cm,５cm
の等間隔だったら、レコードを進ませない姑息な手段でアプローチも可能だけど、
[lablab] [1111111111] [2222222222] [3333333333]
と
３cm,５cm,５cm,５cm
なんて感じで、ラベルエリアは３ｃｍデータエリアは５ｃｍだと、
この手は使えないんですね。。。。
大丈夫だって、たぶん、女の子、男の子を落とすとき、
本人なりに告白は（ＶＢＡは）アレンジして使ってくれるって。
レポートって、普通余白があるから、
[余白2cm] [1111111111] [1111111111] [2222222222] [3333333333]
[余白2cm] [1111111111] [1111111111] [2222222222] [3333333333]
って感じのレポートなら、余白を0.5や0にして
[0.5] [1.5あけてlab3 ] [1111111111] [2222222222] [3333333333]
とか、余白をなくして、
５cm,５cm,５cm,５cm
の左端5の中で、自分でラベルをずらせば(2.0+3.0で5にしたり)なんとかなるかも。
この小細工アプローチで、(いつもの正面から行かない逃げ手で)
女の子、うまく落とせるといいけど。
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
あれ？質問者って、男性？女性？どっちだったっけ？
まぁイイヤ、たぶん私のメルマガ女性はあまり読んでないだろうし（笑）
/*
* ４．おわりの挨拶
*/
今回は、Accessのレポートで、
・Me.NextRecord = False を使用してレコードの制御
・.Visible = True/Falseを使用して印刷（表示）の切り替え
って話でした。
メルマガの中身はふざけてる言葉が多いけど、
サンプルは真剣に作ったので、
http://www.ken3.org/vba/lzh/vba076.lzh
にtest076.mdb(Access97版)が保存されています。
テストで使ってみてください。
拾い読みして、
１つでも何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
※評価は↓で投票してね。感想は掲示板かメールでくださいね。
＜Not演算子で細工する、プログラムはパズルのように...＞
こんにちは、三流プログラマーＫｅｎ３です。
今回は、
Not演算子を使って細工する方法を書きます。
少し本題へ行く前置きが長いけど、
最後まで読んでもらえるとなんとなく、書きたかったことがわかると思います。
/*
* １．今回のキッカケ
*/
ASP系のメルマガで、StrConvが使えなかったので、
文字数のカウント処理を自作で作って遊んでました。
そのコードに対して、下記のメールをもらいました。
In message "re:[ASPで遊ぶ No.052] - キャラクタコード....",
> 二年目プログラマーの西 ＊＊＊です。
>> nCODE = Asc(Mid(strMOJI, n, 1)) 'ｎ番目の文字コードを求める
>> If nCODE >= 0 And nCODE <= 255 Then 'コードが１バイト文字内か？
>
> 三流だとAnd演算子も知らない？ありえねぇ〜
---
いつものありがたい、ご意見／クレーム？メールをいただきました。
本名でクレーム書いて来るって、潔いよね。
（実は本名じゃなかったりして、、、
西多摩雄とかニシタマオだったら相手にしないんだけど）
そんな関係ない話は置いといて、
/*
* ２．問題のコードとAnd演算子の使い方
*/
'文字列を受け取り、バイト数を返す
Function Byte_Count(strMOJI)
bcnt = 0
'文字数分ループして、コードを表示
For n = 1 To Len(strMOJI)
nCODE = Asc(Mid(strMOJI, n, 1)) 'ｎ番目の文字コードを求める
If nCODE >= 0 And nCODE <= 255 Then 'コードが１バイト文字内か？
bcnt = bcnt + 1
Else
bcnt = bcnt + 2
End If
Next
'リターン値をセットする
Byte_Count = bcnt
End Function |
指摘場所は、バイト数を計算している関数内の
nCODE = Asc(Mid(strMOJI, n, 1)) 'ｎ番目の文字コードを求める
If nCODE >= 0 And nCODE <= 255 Then 'コードが１バイト文字内か？
bcnt = bcnt + 1
Else
bcnt = bcnt + 2
End If
の場所ですね。
まぁ、
If nCODE >= 0 And nCODE <= 255 Then 'コードが１バイト文字内か？
でも、動いているのですが、たぶん美的意識、美観的に良くない、
nCODE And &HFF00 とAnd演算子を使用してマスクしろって感じなんだろうなぁ。
えっ、Andって演算子だったの？
そうですよ？知らなかった？
nCODE >= 0 And nCODE <= 255
をわかり易くするために、まず（）を付けます、
(nCODE >= 0) And (nCODE <= 255)
(True) And (True) みたいに、演算してるんですね（論理演算だけど）
And &hFF00とすることで、
上のビットを残し、下のビットを消すなんてことが出来るんですね。
If nCODE >= 0 And nCODE <= 255 Then 'コードが１バイト文字内か？
を
If (nCODE And &HFF00) = 0 Then 'コードは１バイトか？ *asp055
みたいに書くことができます。
０以上で２５５（含む）より下か？とＩｆ文を作成して、
１バイトか？判断するのもありだし、
FF00でAndして、判断するのもひとつの手なんですよ。
今回は、好みの問題ってことであまり実害は無いけど、
And演算子、頭のスミに入れて置いてください。
http://www.ken3.org/cgi-bin/test/test055-1.asp?DATA=Ken3%82%CD%8EO%97%AC
で、And &HFF00バージョンの確認ができます。
※同じく動作することを確認してみてください。
/*
* ３. Not演算子を使って細工する
*/
なんて書いて、ＡＳＰ系と同じだと発行回数稼ぎになってしまうので、
（発行数稼いでも意味無いんだけど）
Not演算子について書きます。
~~~~~~~~~
Not演算子？あまり三流君のプログラムでは、見かけないよね。
でも、一流どころのＨＰに行くとよく見かけるよね。
ギク、痛いとこ突くなぁ。（笑）
使い方は簡単で、結果が逆になると思ってくれれば、わかりやすいかなぁ。
ファイルの終わりまでのループをEofでチェックしてます。
EOF=Trueはファイルエンド
EOF=Falseはまだファイルエンドになっていない時の状態です。
私のいつもの書き方だと、
Do While Rs.EOF = False
と、.EOFがFalseの時ループと書いてます。
よくみかけるプロらしい書き方は、
Do While Not Rs.EOF
と、Rs.EOFの値をNotで逆にして条件で使用してます。
見た目もノットファイルエンドと読んだまま、そのままです。
まぁ、これも、好みと言えば逃げられちゃうけど（どちらでもいいけど）
１つ前回作ったプログラムでラベルと実データの表示を切り替える処理がありました。
Private pFLG As Boolean '印刷制御フラグ
Private Sub ページヘッダー_Format(Cancel As Integer, FormatCount As Integer)
pFLG = False '印刷してないに設定する
End Sub |
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
If (Me![cntA] Mod 3) = 1 Then '左端なら
If pFLG = False Then 'まだラベルエリアを印刷してなかったら
Me.NextRecord = False 'レコードの移動をまず止める
pFLG = True '印刷フラグを立てる
'ここにラベルのＯｎ／Ｏｆｆ処理を入れる
Me![lab01].Visible = True
Me![lab02].Visible = True
'実データをＯｆｆ
Me![ID].Visible = False
Me![WrietTime].Visible = False
Me![F_TITLE].Visible = False
Me![F_MEMO].Visible = False
Else
'ここにラベルのＯｎ／Ｏｆｆ処理を入れる
Me![lab01].Visible = False
Me![lab02].Visible = False
'実データをＯｆｆ
Me![ID].Visible = True
Me![WrietTime].Visible = True
Me![F_TITLE].Visible = True
Me![F_MEMO].Visible = True
End If
Else
pFLG = False 'その他の時
End If
End Sub |
よく見ると、同じような代入処理が見つかります。
ラベルがTrueの時、実データをFalse
ラベルがFalseの時、実データをTrue
とセットしてます。
※まぁ、どちらか１つの印刷だから。
さてと、下記のようにNot演算子を使用して、細工してみます。
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
If (Me![cntA] Mod 3) = 1 Then '左端なら
'フラグを使用して可視／不可視をセットする
Me![lab01].Visible = Not pFLG 'ラベルはフラグの逆をセット
Me![lab02].Visible = Not pFLG
'実データ
Me![ID].Visible = pFLG '実データにはフラグそのままセット
Me![WrietTime].Visible = pFLG
Me![F_TITLE].Visible = pFLG
Me![F_MEMO].Visible = pFLG
If pFLG = False Then 'まだラベルエリアを印刷してなかったら
Me.NextRecord = False 'レコードの移動をまず止める
pFLG = True '印刷フラグを立てる
End If
Else
pFLG = False 'その他の時
End If
End Sub |
pFLGの印刷フラグの意味を、実データ印刷として、
ラベルにはNot pFLGをセット、実データにはそのままpFLGをセットして、
可視／不可視の切り替えを行ってます。
flg=True(男性)/False(女性)なんてデータの時
If flg=True Then '男性/女性の判断
Me![男性].Visible = True
Me![女性].Visible = False
Else
Me![男性].Visible = False
Me![女性].Visible = True
End If
とやってもいいし、
下記のようにNot演算子を使用して、
Me![男性].Visible = flg
Me![女性].Visible = Not Flg
で切り替える、そんな小細工もプログラマー的には、アリですよ。
/*
* ４．おわりの挨拶
*/
今回は、
・And演算子の説明
・Not演算子の説明
・Not演算子でセットする値を逆にして小細工してみた
って話でした。
拾い読みして、
１つでも何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
※評価は↓で投票してね。感想は掲示板かメールでくださいね。
＜Outlookでファイルを添付するには？.Attachments.Add＞
こんにちは、三流プログラマーＫｅｎ３です。
今回は、
VBAでOutlookにファイルを添付するには？
です。
/*
* １．今回のキッカケ
*/
seltaeb@倉敷さん から
>はじめまして
>検索で「Outlookを操作してメールを送りたい」にたどり着き早速メルマガ登録し
>ました
>
>現在１つのBOOKを業者別に複数のBOOKに分割するところまで作成しております
>次のステップとして業者別のBOOKをMailに添付して自動で送ろうと考えています
>メルマガを参考とさせていただき作成したいと思います
>
>あと、ファイル添付の方法が分からないのでご教示ください
>
>よろしくお願いします
----
ご教示かぁ、、、三流作者にはそんなこと言わなくていいのにね。
なんて書いてないで、調べますか。
/*
* ２．ヘルプの探し方
*/
ヘルプで添付をキーワードに調べると。
.Attachments.Add
ってのが見つかる。（ネットでoutlook 添付で探すと一発だけど）
嘘つくなよテメエ、ＥｘｃｅｌＶＢＡのヘルプにそんなの無いぞ。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
素人だと思ってバカにしやがって、いつもヘルプ見ろヘルプ見ろってうるせえ。
Excelのヘルプで添付が出てこないから聞いてんだろ。
まぁまぁ、そんなに興奮しないでよ、どこかの危険な掲示板じゃないんだから。
えっと、これ、Outlookを起動してから、Alt+F11押すと、
OutlookのＶＢＡ編集画面が出るんですよ。
ここで、F1（ヘルプ）押して添付とキーワード入力をすると、
Attachmentsオブジェクトを見つけることが出来ます。
※outlook2000,20002からで、97は出ません（残念、、、）
↑ヘルプの検索イメージ
さてと、
Attachmentsオブジェクトのヘルプを見ると、
---
アイテムに添付ファイルを追加するには、Add メソッドを使用します。
一貫した結果を得るには、アイテムの Attachments コレクションのオブジェクトを
追加したり削除したりする前に、アイテムを必ず保存します。
次の VBA の例は、新しいメッセージを作成し、Q496.xls ファイルをリンクではなく
添付ファイルとして添付し、その添付ファイルにわかりやすいキャプションを付けます。
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
myItem.Save
Set myAttachments = myItem.Attachments
myAttachments.Add "C:\My Documents\Q496.xls", _
olByValue, 1, "1996 年の第 3 四半期報告"
---
なんて載ってます。
/*
* ３. 単体テスト
*/
ヘルプでオブジェクトがわかったので、
.Attachments.Add "ファイル名"でいいのかな。
単体のテストプログラムで確認してみる。
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 _
& "三流君です。 www.ken3.org よろしく（笑）"
objMAIL.To = "test@ken3.org" '宛先
objMAIL.Subject = "未承諾広告※（笑）" '件名
objMAIL.Body = strMOJI '本文の代入
objMAIL.Attachments.Add "e:\work\test.txt"
objMAIL.Send '直接送信箱行き
End Sub |
実行すると、
あれ？
プログラムが自動的に電子メールを送信しようとしています
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
だってさ。※私のExcel2002とOutlook2002の組み合わせではこんな感じでした。
↑警告画面のイメージ
はい を押すと、無事に送信箱に添付ファイル付のメールが保存されました。
まぁ、
.Attachments.Add "ファイル名"
で、添付はできたかぁ。。。
う〜ん、まぁ、ウイルス問題もあるし、こんな感じなのかなぁ。
警告メッセージみて、ウイルスだとか騒がれるのもイヤなので、
.Send を .Display に変えて、確認してもらってから、
ユーザーに送信ボタンを押してもらう(送信ボタンを押しても、送信トレイに行くだけ)
そんな操作に変えてもらうか、、、
※それだと、連続自動実行ができないじゃん、、、
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 _
& "三流君です。 www.ken3.org よろしく（笑）"
objMAIL.To = "test@ken3.org" '宛先
objMAIL.Subject = "未承諾広告※（笑）" '件名
objMAIL.Body = strMOJI '本文の代入
objMAIL.Attachments.Add "e:\work\test.txt"
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 |
※もう一工夫必要みたいですね。
/*
* ４．おわりの挨拶
*/
今回は、
・添付付のメッセージをOutlookから送る方法
・ウイルス防止なのか？Outlook2002で送信確認のメッセージが出た
って話でした。
解決してないって？バレた（笑）
拾い読みして、
１つでも何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
※評価は↓で投票してね。感想は掲示板かメールでくださいね。
もらった、感想メールです。
In message "QA VBA - No.78",
>たっきーさん <xxxx@xxx.xxx> から
>送信確認メッセージが出るというところですが、某書で見た解決法があります。 .display のあとで
>SendKeys "%s", True
>と入れておくと送信までしてくれるようですよ。ただしOultlookがもたもたしていると"%s"が間に合わないので、個人的には
>If Excel.Application.Wait(Now + TimeValue("0:00:10")) Then
> SendKeys "%s", True
>End If
>などとやってお茶を濁しています。異なる環境でうまくいくかどうか分かりませんがお試しください。（私の環境はExcel2000/Outlook2000です。）
----
なるほど、かわしかたがありそうですね。
＜SJIS--JISコードの文字列を作成したい＞
こんにちは、三流プログラマーＫｅｎ３です。
今回は、
読者の人から、
Excelのセルに入っている漢字をＪＩＳコードの文字列にしたい
と軽い質問を受けました。
/*
* １．仕様書、書いてますか？
*/
まずは、要求をまとめるんだっけ。
入りのデータは"漢"などの文字列で、
結果を文字列でFFFFなどの１６進数で返す。
Ｆｕｎｃｔｉｏｎ SJIStoJIS(strMOTO as String)
としますか。
なんて、ラフな仕様なんだ・・・
（こんなの仕様書じゃないよ、よくアンタの後輩は作ってたよねこんなんで（爆））
コード変換の仕様を渡さないで、プログラマーに調べながらヤレって？
まぁまぁ、調べながらやりますから、黙っててください。
/*
* ２．初期捜査、初動捜査
*/
よくある話で、がんばって作ったら、標準関数で存在した？って話があります。
少し、Ｅｘｃｅｌのワークシート関数を見てみよう。
おっ、JISって関数ある、これって？
=JIS(A1)
とやると、あっ、半角を全角にするんだぁ。
さらに続けて捜査すると、
=CODE
文字列の先頭文字に対応する ASCII または JIS コードを返します。
戻り値のコード番号は、作業中のコンピュータで使用されている文字セットに
対応しています
これで、ＪＩＳのコードが返るので、あとは１６進数にすれば、
１６進数にするのは、
DEC2HEX
10 進数を 16 進数に変換します。
DEC2HEX(数値,桁数)でできるのかぁ。
あれ、使えないよ、、何でだろ？
※あとでわかったのですが、分析ツール？をインストールしてないと、
使えないみたいです。
全てＶＢＡでやろうとしないで、ワークシート関数を探すのも必要ですよ。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
/*
* ３．VBAで作成するか
*/
当初の予定通り、ＶＢＡで作成します。
10進数を16進数に変換
は
strHex = Hex(Dec)
で変換できます。
が、ＪＩＳコードの変換関数がVBAに見当たらない、、、オイオイ。
ヘルプでシフトＪＩＳをＪＩＳに直す関数をチェックすると、
えっ無いの？（探し方が悪いのか？それとも漢字コードなんて気にしないのか？）
ここは、ネットで検索してみるか、
シフトJIS JISコード 変換表
^^^^^^^^^^^^^^^^^^^^^^^^^^
この３つをキーワードにgoogleで検索する
OSF 日本ベンダ協議会 (OSF/JVC) 推奨
日本語 EUC ・シフト JIS 間コード変換仕様とコード系実態調査
http://www.opengroup.or.jp/jvc/cde/sjis-euc.html
日経ソフトウエア JIS漢字コード
http://software.nikkeibp.co.jp/software/special/jiscode/nc.html
なんだか、よくわかんないよ（笑）
オレは変換プログラムを書きたいんだってば、
＊自分で変換の意味見て計算式ぐらい書けよ。
と読者の声が聞こえたところで、
初心者によるエンコーディングと文字セットメモ
http://sanaki-web.hp.infoseek.co.jp/code/encode.htm
を見ると、やっと変換の式が書いてある。
---
>S-JIS -> JIS
>if(第一バイト <= 0x9F){
>第一バイト = 第一バイト - 0x71
>}
>else{
>第一バイト = 第一バイト - 0xB1
>}
>第一バイト = 2 * 第一バイト + 1
>if(第ニバイト > 0x7F){
>第ニバイト = 第ニバイト - 1
>}
>if(第ニバイト >= 0x9E){
>第ニバイト = 第ニバイト - 0x7D
>第一バイト = 第一バイト + 1
>}
>else{
>第ニバイト = 第ニバイト - 0x1F
>}
----
を元に作成してみる。
なんかぎこちないコードだけど、下記のように、自作しました。
'シフトJISコードの文字列を受け取り、ＪＩＳコードを返す
Function SJIStoJIS(strSJISCODE As String) As String
Dim hi As Long
Dim lo As Long
'シフトJISコードの上位バイトを hi、下位バイトを lo とします。
hi = Val("&h" & Mid(strSJISCODE, 1, 2))
lo = Val("&h" & Mid(strSJISCODE, 3, 2))
'hi が 0x9f 以下の場合、 hi から 0x71 減じます。
'そうでない場合、 hi から 0xB1 減じます。
hi = hi - IIf(hi <= &H9F, &H71, &HB1)
'hi に 2 を乗じて、さらに 1 を加えます。
hi = hi * 2 + 1
'lo が 0x7F より大きい場合、 lo から 1 減じます。
If lo > &H7F Then lo = lo - 1
'lo が 0x9E 以上の場合、lo から 0x7D 減じて、hi に 1 加えます。
If lo >= &H9E Then
lo = lo - &H7D
hi = hi + 1
Else 'そうでない場合、 lo から 0x1F 減じます。
lo = lo - &H1F
End If
'結果を返します
SJIStoJIS = Right("0" & Hex(hi), 2) & Right("0" & Hex(lo), 2)
End Function |
使い方は、１文字単位でAsc関数でシフトＪＩＳコードを取り出し、
Hexで１６進文字列にして渡します。
Sub test()
Dim strMOJI As String
Dim strWORK As String
Dim n As Integer
strMOJI = "仕様書"
strWORK = ""
For n = 1 To Len(strMOJI) '普通は半角のチェックが無いとマズイよね
strWORK = strWORK & SJIStoJIS(Hex(Asc(Mid(strMOJI, n, 1))))
Next n
MsgBox strWORK
Debug.Print strWORK
End Sub |
なんか、変換の嵐でわかりにくいけど、
"仕様書"を変換すると
3B45 4D4D 3D71
となります。
あとは、応用して使ってみてください。
/*
* ４．終わりの挨拶
*/
今回は、
シフトＪＩＳコードをＪＩＳにする方法でした。
でした。
なんか、標準関数でありそうなんだけどなぁ・・・
プログラム作りは簡単で面白いなぁと感じるような
解説／メールマガジンを書きたいと思ってます。
拾い読みして、
１つでも何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
----------------------------------
有料メルマガ書いてます。こちらもよろしく。
----------------------------------
下記、有料版VB.NETのサンプルです
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
http://www.ken3.org/pmagmag/vbnet/ が登録ページです、登録してね
いろいろとまだ苦戦してます、
有料誌のレベルまで行ってないけど（笑）
^^^^^^^^^^^^^^
※不況の中、余金のあるひとは、笑い話、三流君を笑って優越感に浸る
などの使い道で購読してください、月額390円です。
＜.Text.Lengthで文字数 .Text.Chars(n)で一文字取出せます＞
(有料版VB.NETのサンプル)
どうも、三流プログラマーのＫｅｎ３です。
今回も軽めに
・.Text.Lengthで文字数
・.Text.Chars(n)で一文字取出せます
・＋＝なんて演算も可能
です。
気楽に読んでください。
/*
* １. 昔のコード
*/
画面仕様
調査文字列 [ _______________ ] txtMOJI
結果 [ ____________________ ] txtOUT
[ ____________________ ] 複数行可能とする
流れ
ユーザーが確認したい文字列を入力後、調査開始のボタンを押します
文字列から１文字単位で文字を取り出し、コードを表示します。
時代遅れな昔のやり方？
Len関数で文字数を求め、
Mid関数で文字列を抜き出し、
Asc関数でコードを表示します
Private Sub btnRUN_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles btnRUN.Click
Dim n As Integer 'カウンタ
Dim strWORK As String '文字保存
Me.txtOUT.Text = "" '結果エリアを初期化
For n = 1 To Len(Me.txtMOJI.Text)
strWORK = Mid(Me.txtMOJI.Text, n, 1)
Me.txtOUT.Text = Me.txtOUT.Text & strWORK & " - " & Asc(strWORK) _
& vbCrLf
Next
End Sub
昔ながらの方法ですね。
ポイントは、
Len関数で文字数を求め、
For n = 1 To Len(Me.txtMOJI.Text)
と１文字目から最終文字までループさせる
strWORK = Mid(Me.txtMOJI.Text, n, 1)とｎ文字目を取りだし
Me.txtOUT.Text = Me.txtOUT.Text & strWORK & " - " & Asc(strWORK) & vbCrLf
結果 = 結果 に strWORKと取出した文字を＆して、
" - " と固定文字を付けて
Asc(strWORK) と文字コードを変換して追加、
最後に改行を追加してます
/*
* ２．VB.NETで書ける書き方(有料版VB.NETのサンプル)
*/
まぁ、動けばどちらでもいいのですが、
Private Sub btnRUN_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles btnRUN.Click
Dim n As Integer 'カウンタ
Dim strWORK As String '文字保存
Me.txtOUT.Text = "" '結果エリアを初期化
For n = 1 To Me.txtMOJI.Text.Length '文字数分ループする
strWORK = Me.txtMOJI.Text.Chars(n - 1) '配列が０からなので
Me.txtOUT.Text += strWORK & " - " & Asc(strWORK) & vbCrLf
Next
End Sub |
と見なれない書き方が出来ます。
ポイントは、
Me.txtMOJI.Text.Length でテキストボックスの文字数がわかります
コントロールが文字数のプロパティを持っているんですね。
で、次のポイントが、
Me.txtMOJI.Text.Chars(n - 1) '配列が０からなので
ここで、何してるかと言うと、
.Text.Chars(0) １文字目
.Text.Chars(1) ２文字目
.Text.Chars(2) ３文字目
と０からの配列みたいに文字を取出すことができます。
LenとMidを使わないで、コントロールを参照してかけました。
あとは、違和感在るのが、
Me.txtOUT.Text += strWORK & " - " & Asc(strWORK) & vbCrLf
この+=って？な感じですが、
a = a + 1 と累積加算する式を
a += 1 とａに+１すると素直に書くことが出来ます。
Me.txtOUT.Text (+=)に strWORK & " - " & Asc(strWORK) & vbCrLfを足す
そんな感じで短く書けます
strMOJI = strMOJI & "XXXXXX"
strMOJI = strMOJI & "ZZZZZZ"
を
strMOJI += "XXXXXX"
strmoji += "ZZZZZZ"
と書くことが出来ます。
/*
* ３．終わりの挨拶
*/
VB.Net風のやり方？かわかりませんが、
こんな感じで書くことが出来ます。
使えるツール作り、、、までの道のりは長そうです。
気長に待てる人は、購読続けて下さい。
＊解説、長くかかりそうなので。
プログラム作りは簡単で面白いなぁと感じるような
解説／メールマガジンを書きたいと思ってます。
よろしくお願いします。
ＡＢ型の変わり者、三流プログラマーのＫｅｎ３でした。
＜イベントの共有＞(有料版VB.NETのサンプル)
どうも、三流プログラマーのＫｅｎ３です。
今回は、イベントの共有について書きたいと思います。
/*
* １. イベントに対してコードを書く(有料版VB.NETのサンプル)
*/
コントロールを貼って、
それに対するイベントを意識してプログラムを書きましょう
と説明してました。
※しつこいよね毎回毎回。
ボタンをクリックしたら〜する
閉じるボタンもボタンが押されたら、
Private Sub btnCLOSE_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles btnCLOSE.Click
Me.Close() '自分を閉じる
End Sub |
Me.Close
~~~~~~~~
でフォームを閉じる、、
と
ボタンのクリック
~~~~~~~~~~~~~~~~
に対応するイベントを書きました。
/*
* ２．固定概念？を壊してくださいね。(有料版VB.NETのサンプル)
*/
私だけかもしれませんが、
イベントＸＸＸが発生したらＺＺＺＺをする。
基本をこんな感じで覚えてました。
私から見ると当然の話で、
ボタンＡのクリックイベント、Ｂのクリックイベントは違うイベントで記述。
そんな私の固定概念があったのですが、
こんな書き方もできます。
ボタンを３つ作ります。
Button1 Button2 Button3 とオブジェクトを作成しました。
通常、ボタン１のクリックイベントを作成すると、下記のような感じです。
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click
End Sub |
これに少し細工をして、
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click, _
Button2.Click, Button3.Click
MsgBox(sender.text)
End Sub |
と、Handlesの後ろに、Button2.Click, Button3.Clickを追加します。
で、実行すると、
なんと、ボタン２、３を押した時も、このPrivate Sub Button1_Clickが走る。
そんなに驚くなって？
まぁ、からくりは、
Handlesのイベントハンドラでボタン１〜３のクリックに対してと定義したからです。
私の固定概念は、１イベント１関数だったのですが、
複数のイベントを処理する関数を作成可能なことがわかりました。
まだ慣れてないけど、う〜んＶＢ.ＮＥＴ奥が深そうです。
/*
* ３．終わりの挨拶
*/
VB.Net風のやり方？
私もまだまだなので、コントロールの説明と合わせながら、
昔ながらの流れの説明もして行きたいと思います。
使えるツール作り、、、までの道のりは長そうです。
気長に待てる人は、購読続けて下さい。
＊解説、長くかかりそうなので。
プログラム作りは簡単で面白いなぁと感じるような
解説／メールマガジンを書きたいと思ってます。
よろしくお願いします。
ＡＢ型の変わり者、三流プログラマーのＫｅｎ３でした。
＜JISコードの表示ツールを作る＞(有料版VB.NETのサンプル)
どうも、三流プログラマーのＫｅｎ３です。
今回は、
漢字のＪＩＳコードの表示ツールを作ってみたいと思います。
今回の画像付きの解説、
http://www.ken3.org/p/e/vbnet013.html
で見れます、
プログラムは、
http://www.ken3.org/p/e/vbnet013.lzh
に圧縮したプロジェクトが入ってます。
あわせて見てください。
/*
* １. 仕様を決める(有料版VB.NETのサンプル)
*/
画面仕様
調査文字列 [ _______________ ] txtMOJI
結果 [ ____________________ ] txtOUT
[ ____________________ ] 複数行可能とする
流れ
ユーザーが確認したい文字列を入力後、調査開始のボタンを押します
文字列から１文字単位で文字を取り出し、コードを表示します。
オヤ？どこかで見たような？仕様だなぁ。
文字コードの表示で使ってた画面と一緒ですね。
txtMOJIと入力用にテキストボックスを作成して、
結果をtxtOUTに書き込むことにします。
/*
* ２．下準備、調べごと(有料版VB.NETのサンプル)
*/
漢字コード、JISコードの変換関数ないかなぁ、と調べ始める。
Asc関数をヘルプで見ると、返ってくるコードは、
解説
Asc は、入力文字に対するコード ポイント (文字コード) を返します。
2 バイト文字セット (DBCS: Double-Byte Character Set) 値に対しては
-32768 〜 32767 です。
返される値は、TextInfo クラスの ANSICodePage プロパティに含まれている
現在のスレッドのコード ページによって異なります。
TextInfo.ANSICodePage は、
System.Globalization.CultureInfo.CurrentCulture.TextInfo.ANSICodePage
を指定することによって取得できます。
なんかよくわかんないねぇ。
MsgBox(Hex(Asc("愛")))
で実際にテストしてみよう。
FFFF88A4？なにこれ？
( 
実行画像)
どうやら、シフトＪＩＳみたいですね、頭のＦＦＦＦは気になるけど、
88A4がシフトＪＩＳです。
とすると、シフトＪＩＳをＪＩＳに直す関数をチェックすると、
えっ無いの？（探し方が悪いのか？それとも漢字コードなんて気にしないのか？）
シフトJIS JISコード 変換表
をキーワードにgoogleを検索する
OSF 日本ベンダ協議会 (OSF/JVC) 推奨
日本語 EUC ・シフト JIS 間コード変換仕様とコード系実態調査
http://www.opengroup.or.jp/jvc/cde/sjis-euc.html
日経ソフトウエア JIS漢字コード
http://software.nikkeibp.co.jp/software/special/jiscode/nc.html
なんだか、よくわかんないよ（笑）
オレは変換プログラムを書きたいんだってば、
＊自分で変換の意味見て計算式ぐらい書けよ。
と読者の声が聞こえたところで、
初心者によるエンコーディングと文字セットメモ
http://sanaki-web.hp.infoseek.co.jp/code/encode.htm
を見ると、やっと変換の式が書いてある。
>S-JIS -> JIS
>if(第一バイト <= 0x9F){
>第一バイト = 第一バイト - 0x71
>}
>else{
>第一バイト = 第一バイト - 0xB1
>}
>第一バイト = 2 * 第一バイト + 1
>if(第ニバイト > 0x7F){
>第ニバイト = 第ニバイト - 1
>}
>if(第ニバイト >= 0x9E){
>第ニバイト = 第ニバイト - 0x7D
>第一バイト = 第一バイト + 1
>}
>else{
>第ニバイト = 第ニバイト - 0x1F
>}
を元に作成してみる。
'シフトJISコードの文字列を受け取り、ＪＩＳコードを返す
Function SJIStoJIS(strSJISCODE As String) As String
Dim hi As Long
Dim lo As Long
'シフトJISコードの上位バイトを hi、下位バイトを lo とします。
hi = Val("&h" & Mid(strSJISCODE, 1, 2))
lo = Val("&h" & Mid(strSJISCODE, 3, 2))
'hi が 0x9f 以下の場合、 hi から 0x71 減じます。
'そうでない場合、 hi から 0xB1 減じます。
hi = hi - IIf(hi <= &H9F, &H71, &HB1)
'hi に 2 を乗じて、さらに 1 を加えます。
hi = hi * 2 + 1
'lo が 0x7F より大きい場合、 lo から 1 減じます。
If lo > &H7F Then lo = lo - 1
'lo が 0x9E 以上の場合、lo から 0x7D 減じて、hi に 1 加えます。
If lo >= &H9E Then
lo = lo - &H7D
hi = hi + 1
Else 'そうでない場合、 lo から 0x1F 減じます。
lo = lo - &H1F
End If
'結果を返します
SJIStoJIS = Right("0" & Hex(hi), 2) & Right("0" & Hex(lo), 2)
End Function |
あれ、Right関数にエラーのときの波線が入っているよ。
( 
エラー画像)
なんで？Right関数って無いの？と思い、ヘルプを見ると、
解説
Str の文字数を確認するには、Len 関数を使用します。
Windows フォーム、
または Right プロパティを持つほかの任意のクラスで使用される場合、
Microsoft.VisualBasic.Right で関数を完全修飾する必要があります。
^^^^^^^^^^^^^^^^^^^^^^^^^^^
えっ、そんなこと必要なの、、、
なんか、イヤだなぁ、、、
Private Sub btnRUN_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles btnRUN.Click
Dim n As Integer 'カウンタ
Dim strWORK As String '文字保存
Dim strCODE As String '文字コード１６進
Me.txtOUT.Text = "" '結果エリアを初期化
For n = 1 To Me.txtMOJI.Text.Length '文字数分ループする
strWORK = Me.txtMOJI.Text.Chars(n - 1) '配列が０からなので
Me.txtOUT.Text += ("[" & strWORK & "] - ")
strCODE = Microsoft.VisualBasic.Right(Hex(Asc(strWORK)), 4)
If Len(strCODE) <= 2 Then '１バイト半角文字なら
Me.txtOUT.Text += ("ASCII " & strCODE & "半角です")
Else
Me.txtOUT.Text += ("SJIS=" & strCODE)
Me.txtOUT.Text += (" JIS=" & SJIStoJIS(strCODE))
End If
Me.txtOUT.Text += vbCrLf '改行
Next
End Sub
と、してなんとか作ってみました。
こんなに一生懸命やらなくても、何かいいほうほうがありそうだけど。
/*
* ３．終わりの挨拶(有料版VB.NETのサンプル)
*/
VB.Net風のやり方？
よくわからなくて、すみません。
Microsoft.VisualBasic.Right(Hex(Asc(strWORK)), 4)
これは、なんかガセネタって感じがするけど。。。
"Vb 仕様書"を変換すると、
[V] - ASCII 56半角です
[b] - ASCII 62半角です
[ ] - ASCII 20半角です
[仕] - SJIS=8E64 JIS=3B45
[様] - SJIS=976C JIS=4D4D
[書] - SJIS=8F91 JIS=3D71
と無事変換されました。
使えるツール作り、、、までの道のりは長そうです。
ループ処理や文字列操作の参考になれば幸いです。
気長に待てる人は、購読続けて下さい。
＊解説、長くかかりそうなので。
プログラム作りは簡単で面白いなぁと感じるような
解説／メールマガジンを書きたいと思ってます。
よろしくお願いします。
ＡＢ型の変わり者、三流プログラマーのＫｅｎ３でした。
ページフッター(リンクや広告など)
[三流君(TOP ken3.org へ戻る)]
-- [VBA系TOPへ]
---- [VBA系バックナンバー目次へ移動]
------ [VBAでIEを操作 CreateObject("InternetExplorer.application")]・・・実は当店一番人気、VBAでIEを操作するサンプルです
------ [VBAでOutlookの操作 CreateObject("Outlook.Application")]・・・Outlookを使い、メール関係の処理です
------ [Access から Excel 連携 CreateObject("Excel.Application")]・・・人気のAccessからExcelへデータ書き出しなどです
------ [AccessのUserForm/サブフォームを操作]・・・アクセスでフォームを使ったサンプルです
------ [Accessのレポートを操作]・・・レポートを操作してみました
------ [Access クエリー関係やその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です
------ [Excel UserForm(ユーザーフォーム)を操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
------ [ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
------ [Excel関係 関数、その他]・・・その他Excel関係です
------ [VBAでテキストファイル(*.txt,*.html,*.csv)の操作]・・・テキストファイルを使ったサンプルです
------ [VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます
広告
-- [通販系の売れ筋広告へ] ←主に楽天やAmazonのランキングです
blog
-- [三流君の作業日記] ← 日々の作業を少々
-- [通販あしあと] ← 通販ページの足跡を一覧で羅列
情報を探す
情報を探すならGoogleかな？
↓Web全体、サポート情報(support.microsoft.com)や三流君VBA(ken3.org)から検索する
書籍の購入
Webだけじゃさすがに勉強しきれないので、プログラミング関係の書籍も読んでみては？？
コンピュータ書籍の発送がハヤイ専門店
 コンピュータの本・専門店
|
※種類が豊富で探し易いです。※在庫ありが48時間以内発送が急ぎで資料や書籍がほしい時、とても助かります。
お奨め本の目次を見るだけでも勉強になったり
|
amazon.co.jpでキーワード別チェック
下記、私が設定したキーワードですが、こんな感じで資料や書籍を探ってみては？
[VBA全体を把握する] -- やはり全体をさらっと見たいですよね。
[SQL関連でＤＢ力UP] -- システムはデータベース設計が重要
[ADO接続を探る] -- VBAなのでADO接続を押さえておく
[Windows APIを探る] -- さらにAPIになて知ってれば強力だ！
[.NETを探る] -- と言っても時代は.NETに流れてるし
プログラミング以外でも知りたいことは多くって、
[人間関係] -- で、客先・上司、まわりに気を使い。
[プログラマーの自己啓発] -- プログラムだけじゃなくいろいろと向上したいよ
[コーチング・育成] -- 先輩になったら後輩(部下)の面倒をみてね。
そんなこんなでプログラマーっていろいろと大変なんだってば・・・