EXERCISE02: train0202

2007-1-9 by KOMPas

exercise02.xls

■

「予定ヨテイ表ヒョウ」のデータを、データベースに保存ホゾンしたり、データベースから読ヨみ込コんだりしてみましょう。

■

EXERCISE では、「EXCELマクロのお勉強ベンキョウ」セット\otenki フォルダにある、otenki.mdb を使ツカいます。

展開テンカイした\otenki フォルダが、「マイドキュメント」や「デスクトップ」等トウにあると、

これからデータベースへの入出力ニュウシュツリョクコードを書カくとき、データベースを指定シテイするのが長ナガくなるので、

フォルダ毎ゴトコピーして、ハードディスクのわかりやすい（記述キジュツが簡単カンタンな）場所バショに作ツクり直ナオした方ホウが、あとで楽ラクです。

例タトえば、「デスクトップ」にあるotenki.mdb を記述キジュツするには、

C:\Documents and Settings\KOMPas\デスクトップ\otenki\otenki.mdb

「マイドキュメント」にあるotenki.mdb を記述キジュツするには、

C:\Documents and Settings\KOMPas\My Documents\otenki\otenki.mdb

と書カかないとなりませんが、(空白クウハク文字モジを含フクんでいるのでなおややこしい)

ハードディスク「C:」に貼ハり付ツけた場合バアイなら、

C:\otenki\otenki.mdb

ですみます。

■

「予定ヨテイ表ヒョウ」に、データベース操作ソウサ用ヨウのボタン、及オヨび「アカウント」「パスワード」欄ランを設定セッテイする。

■

あなたの練習レンシュウ用ヨウEXCEL カレンダ.xlsの「予定ヨテイ表ヒョウ」に、ボタンを２つ足タします。（サンプル参照）

セルJ2 に、「データベースへ保存ホゾン」

セルJ4 に、「データベースから読込ヨミコミ」

と書カき込コんで、セルの色イロを変カえれば、ボタンのようにみえます。（かな？）

「ボタン」の場所バショや色イロや幅ハバはお好コノみで設定セッテイできますが、

セルの場所バショを変カえたなら、当然トウゼンコードもかきかえる必要ヒツヨウがあります。

■

「アカウント」欄ラン、「パスワード」欄ランを作ツクっておきましょう。（サンプル参照サンショウ）

セルJ6 を、「アカウント」欄ランにします。

セルJ8 を、「パスワード」欄ランにします。

J6、J８に「入力ニュウリョクする場所バショ」であることがわかるように、薄ウスい色イロをつけておきます。

わかりやすいように、J5、J7にラベルを書カき込コみます。（操作ソウサには関係カンケイがない）

■

「予定ヨテイ表ヒョウ」マクロ　BeforeDoubleClick　のイベントプロシージャを書カく。

■

「ツール」「マクロ」「Visual Basic Editor」の順ジュンに開ヒラいて、

左側ヒダリガワの「プロジェクトエクスプローラ」で、Sheet2をダブルクリックします.。

今イマコードを書カき込コもうとしているのは、「カレンダ」ではなく「予定表」です。

右ミギのコード欄ランの、一番イチバン上ウエ左側ヒダリガワが「（general)」となっていれば、「Worksheet」に変更ヘンコウします。

一番イチバン上ウエ右ミギ側ガワを、「BeforeDoubleClick」にします。

■

あらかじめ、次ツギのコードを書カき込コんでください。

（白抜シロヌき文字モジがコード。グリーンおよび橙ダイダイの文字モジは省略ショウリャクしてもよいところです。）

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'Target はデータをダブルクリックした場所。rr はtarget左上セルの行番号、cc は左上セルの列番号。

rr = Target.Row

cc = Target.Column

If rr = 2 And cc = 10 Then

ダブルクリック場所が2行目 10列 (つまりJ2セル)なら、「データベースから読込」

'　　　　　　　　ここに「データベースから読込」コード

ElseIf rr = 4 And cc = 10 Then

ダブルクリック場所が4行目 10列 (つまりJ2セル)なら、「データベースへ保存」

'　　　　　　　　ここに「データベースへ保存ホゾン」コード

Else

'上記以外の場所なら何もしない。

End If

End Sub

■

データベース操作ソウサの為タメのコードを追加ツイカする。

■

データベース関連カンレンのコードを書カく前マエに、EXCELで、次ツギの準備ジュンビが要イります。

Visual Basic Editor 画面ガメンで、「ツール」−「参照サンショウ設定セッテイ」を選択センタクして、

「Microsoft DAO 3.6 Object Library」にチェックをいれて「OK」します。

もう一度イチド、「ツール」−「参照設定」を選エラぶと、

「参照サンショウ設定セッテイ」画面ガメンに、「Microsoft DAO 3.6 Object Library」がチェックされているのを確認カクニンできます。

この設定セッテイは、EXCELファイル毎ゴトに行オコナう必要ヒツヨウがあります。

この設定を行ったEXCELファイルは、マクロからデータベースを操作ソウサするコードを書カくことができます。

実ジツは、Microsoftが推奨スイショウしているのは、DAOではなくADOです。

「コードを皆ミナでつかいまわすこと」の楽タノしさを説明セツメイしている文脈ブンミャクで、

「主流シュリュウ」をはずすのはいかがなものか？、といった問題モンダイがありますが、

DAOは、Windows95以来イライずっと(最近サイキンはこっそりと）、

Microsoft製品の色んな製品で使ツカわれているデータベースエンジンなので、

あと４，５年ネンはサポートされるだろう、ということでご理解リカイを。

（ぼくは自称ジショウ「筋金入スジガネイりのDAOファン」なので）

■

水色ミズイロ部分ブブンが、データベース関連カンレンのマクロを書カくときのおまじないコードです。

あなたのマクロに書カき足タしてください。

データベースを扱アツカうとき、必カナラず書カき込コむコードで、

若干ジャッカン奇妙キミョウに見ミえますが、これさえ書カけば、他ホカはどんなデータベース処理ショリでも同オナじです。

コメント「’操作ソウサするデータベース」に続ツヅくコード「xdb = 」には、あなたのデータベースパスを指定シテイします。

■

データベース処理ショリそのものではありませんが、関連カンレン処理ショリも合アわせてここで書カき込コみます。

これは、黄色キイロ文字モジにしています。

この部分ブブンのコメントは橙ダイダイ文字モジです。省略ショウリャクしてもかまいません。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'操作するデータベース

xdb = "c:\otenki\otenki.mdb"

Dim db As Database

Set db = DBEngine.Workspaces(0).OpenDatabase(xdb)

Dim rs As Recordset

'Target はデータをダブルクリックした場所。rr はtarget左上セルの行番号、cc は左上セルの列番号。

rr = Target.Row

cc = Target.Column

'sheet2 データの最終行 endrrの取得

endrr = 5

For i = 5 To 10000

If Sheet2.Cells(i, 1) & "" = "" Then

Else

endrr = i

End If

Next i

'アカウント/パスワードの読込

usrtext = "_やまがたあきた=yamagata_さかたかな=kompas_とくしまえひめ=tokusima_"

usr = Sheet2.Cells(6, 10): 'アカウント欄データ

pwd = Sheet2.Cells(8, 10): 'パスワード欄データ

'読み込んだらパスワード欄を空白にします。

Sheet2.Cells(8, 10) = ""

'otenki テーブルのデータ更新ルール

'幾つかの理由の為、コードには下記のようなルールを適用します。

'(rule1)簡単なパスワード識別コードで、該当しなければ更新できない。

'(rule2)otenki テーブルデータは、そのデータを作成した（追加した）人しか編集/削除はできない。

'(rule3)データの追加は、アカウント欄に有効な記述があるときのみ、

'　　　「記録者」欄が空白または、「記録者」欄が「_アカウント_」を含む行データを追加できる。

'(rule4)rule2の例外処理として、1レコードの更新の場合のみ、

'       そのデータを作成した（追加した）人でなくても編集/削除ができる。

'       但し、そのデータの記録者は更新者名となるので、

'       アカウントは必要ヒツヨウ。パスワードは無視ムシ。

If rr = 2 And cc = 10 Then

ダブルクリック場所が2行目 10列 (つまりJ2セル)なら、「データベースから読込」

'　　　　　　　　ここに「データベースから読込」コード

ElseIf rr = 4 And cc = 10 Then

ダブルクリック場所が4行目 10列 (つまりJ2セル)なら、「データベースへ保存」

'　　　　　　　　ここに「データベースへ保存ホゾン」コード

ElseIf usr & "" = "" Then

'アカウントがなければ何もしない。

ElseIf rr < 5 Then

'上記以外の場所なら何もしない。

ElseIf rr > endrr Then

'上記以外の場所なら何もしない。

ElseIf cc = 7 Then

'　　　　　　　　ここに「１行ギョウデータのデータベース更新コウシン」コード

Else

'上記以外の場所なら何もしない。

End If

db.close

End Sub

■

「データベース読込ヨミコミ」コード

ダブルクリック場所が2行目 10列 (つまりJ2セル)なら、「データベースから読込」

'画面のクリア

Sheet2.Range("a5:c" & endrr).Value = ""

Sheet2.Range("e5:g" & endrr).Value = ""

'(データベース操作)otenki テーブルを開きます。

sqls = "select * from otenki order by 日付"

Set rs = db.OpenRecordset(sqls)

'i は、sheet2へ書込行(開始は5行目)

i = 5

'読込レコードが終わるまで、Do〜Loop　内の処理を繰り返し実行します。

Do Until rs.EOF

'otenki テーブルから1行ずつ読み込んで、転記します。

'右辺(データベースから取得した値)を左辺(EXCELシートの指定セル)に転記する、

'データベース読込「転記コード」です。

'読み込んだデータの「日付」フィールドの値を、ddxとします。

ddx = rs!日付

'日付ddx の「年」を取得して、sheet2 i行 1列目に転記します。

Sheet2.Cells(i, 1) = Year(ddx)

'日付ddx の「年」を取得して、sheet2 i行 2列目に転記します。

Sheet2.Cells(i, 2) = Month(ddx)

'日付ddx の「年」を取得して、sheet2 i行 3列目に転記します。

Sheet2.Cells(i, 3) = Day(ddx)

'読み込んだデータの「本文」フィールドの値を、sheet2 i行 5列目に転記します。

Sheet2.Cells(i, 5) = rs!本文

'読み込んだデータの「種類」フィールドの値を、sheet2 i行 6列目に転記します。

Sheet2.Cells(i, 6) = rs!種類

'読み込んだデータの「記録者」フィールドの値を、sheet2 i行 7列目に転記します。

Sheet2.Cells(i, 7) = rs!記録者

i = i + 1

'otenki テーブルから、1レコード読み終えたら、次のレコードへ移ります。

rs.MoveNext

Loop

'otenki テーブルから、全てのレコード読み終えたて、otenki テーブルを閉じます。

rs.Close

■

「データベース保存ホゾン」コード

ダブルクリック場所が4行目 10列 (つまりJ2セル)なら、「データベースへ保存」

'otenki テーブルを開いて、「予定表」頁のデータを保存します。

'有効なアカウント名とそのパスワード

If usr & "" = "" Then

MsgBox "アカウントがありません"

ElseIf pwd & "" = "" Then

MsgBox "パスワードがありません"

ElseIf InStr(usrtext, "_" & usr & "=" & pwd & "_") = 0 Then

MsgBox "有効なアカウントではありません"

Else

'(データベース操作)otenki テーブルの、usrが書き込んだデータを全て削除します。

sqls = "delete * from otenki where 記録者 like '*_" & usr & "_*'"

db.Execute sqls

'識別値ednn を、処理日から求めます。

ednn = (Int(DateValue(Now()) * 10 / 10) Mod 10000) * 10000

'(データベース操作)otenki テーブルを開きます。

Set rs = db.OpenRecordset("otenki")

'i は、sheet2データの読込行（開始は5行目)

i = 5

cnt = 0

Do Until i > endrr

'EXCELから読み取った１行を、otenki テーブルに書き込むか書き込まないかを識別します。

'デフォルトは、「書き込まない」です。

addok = 0

If Sheet2.Cells(i, 1) & "" = "" Then

'EXCELデータの先頭データが空白のとき、まま

ElseIf IsDate(Sheet2.Cells(i, 1) & "/" & Sheet2.Cells(i, 2) & "/" & Sheet2.Cells(i, 3)) = False Then

'EXCELデータの年月日が年月日でないとき、まま

ElseIf Sheet2.Cells(i, 5) & "" = "" Then

'EXCELデータの本文がないとき、まま

ElseIf Sheet2.Cells(i, 7) & "" = "" Then

'EXCELデータの記録者欄が空白のとき新規データとして追加する。

addok = True

ElseIf InStr(Sheet2.Cells(i, 7), "_" & usr & "_") Then

'EXCELデータの記録者欄がアカウントにヒットしたら、追加する。

addok = True

End If

If addok Then

'EXCELデータの年月日から、日付xdate を求める

xdate = DateValue(Sheet2.Cells(i, 1) & "/" & Sheet2.Cells(i, 2) & "/" & Sheet2.Cells(i, 3))

'EXCELデータの種類から、xkubun を求める。

'種類に記述がないとき、@usrを代用する。

xkubun = Sheet2.Cells(i, 6)

If xkubun & "" = "" Then

xkubun = "@" & usr

End If

End If

If addok Then

cnt = cnt + 1

'下記cnttextは、通常otenki テーブルに１つしかない（はずの）keyとなります。

cnttext = "_" & usr & "_" & (ednn + cnt)

'「予定表」から1行ずつ読み込んで、otenki テーブルに転記します。

'右辺(EXCELシートの指定セル)を左辺(データベースフィールド値)に転記する、

'データベース書込「転記コード」です。

'otenki テーブルに新規レコードを追加します。

rs.AddNew:

'xdate値を、「日付」フィールドに転記します。

rs!日付 = xdate

'sheet2 i行 5列目データを、「本文」フィールドに転記します。

rs!本文 = Sheet2.Cells(i, 5)

'xkubun値を、「種類」フィールドに転記します。

rs!種類 = xkubun

'cnttext値を、「記録者」フィールドに転記します。

rs!記録者 = cnttext

rs.Update

'データベースに書き込んだ記録者データをEXCEL上でも書き換えます。

Sheet2.Cells(i, 7) = cnttext

End If

i = i + 1

Loop

rs.Close

End If

■

「１行データのデータベース更新」コード

If InStr(usrtext, "_" & usr & "=") = 0 Then

MsgBox "有効なアカウントではありません"

Else

'「記録者」欄がダブルクリックされたとき、その記録者欄データを取得します。

tgtednn = Sheet2.Cells(rr, cc)

If Sheet2.Cells(rr, 1) & "" = "" Then

'EXCELデータの先頭データが空白のとき、まま

ElseIf IsDate(Sheet2.Cells(rr, 1) & "/" & Sheet2.Cells(rr, 2) & "/" & Sheet2.Cells(rr, 3)) = False Then

'EXCELデータの年月日が年月日でないとき、まま

ElseIf Sheet2.Cells(rr, 5) & "" = "" Then

'EXCELデータの本文がないとき、まま

ElseIf Sheet2.Cells(rr, 7) & "" = "" Then

'EXCELデータの記録者欄が空白のとき新規データとして追加する。

addok = True

ElseIf InStr(Sheet2.Cells(rr, 7), "_" & usr & "_") Then

'EXCELデータの記録者欄がアカウントにヒットしたら、追加する。

addok = True

End If

If addok Then

'EXCELデータの年月日から、日付xdate を求める

xdate = DateValue(Sheet2.Cells(rr, 1) & "/" & Sheet2.Cells(rr, 2) & "/" & Sheet2.Cells(rr, 3))

'EXCELデータの種類から、xkubun を求める。

'種類に記述がないとき、@usrを代用する。

xkubun = Sheet2.Cells(rr, 6)

If xkubun & "" = "" Then

xkubun = "@" & usr

End If

End If

'MsgBox xdate & " " & xkubun

If addok Then

If tgtednn & "" = "" Then

Else

'データベース上の既存データを削除します。

sqls = "delete * from otenki where 記録者='" & tgtednn & "'"

db.Execute sqls

End If

'識別値ednn を、処理時から求めます。

ednn = (Int(DateValue(Now()) * 10 / 10) Mod 10000) * 1000000 + 900000 + Int(TimeValue(Now()) * 100000)

'(データベース操作)otenki テーブルを開きます。

Set rs = db.OpenRecordset("otenki")

'右辺(EXCELシートの指定セル)を左辺(データベースフィールド値)に転記する、

'データベース書込「転記コード」です。

'otenki テーブルに新規レコードを追加します。

rs.AddNew

'xdate値を、「日付」フィールドに転記します。

rs!日付 = xdate

'sheet2 i行 5列目データを、「本文」フィールドに転記します。

rs!本文 = Sheet2.Cells(rr, 5)

'xkubun値を、「種類」フィールドに転記します。

rs!種類 = xkubun

'ednn値を、「記録者」フィールドに転記します。

rs!記録者 = "_" & usr & "_" & ednn

rs.Update

'データベースに書き込んだ記録者データをEXCEL上でも書き換えます。

Sheet2.Cells(rr, 7) = "_" & usr & "_" & ednn

rs.Close

End If

End If

■

ふぅ。