Kozupon.com    
 
 VisualBasicで住所録を作ろう!


概要:

近来、WindowsがパソコンOSの地位を築いてからVisualBasicでプログラミングする機会も増えてきたかと思います。小生も仕事で制御系のソフトウェア開発を行っていますが、Windows上での開発が必須になってきたのでVisualBasicにはお世話になっています。そのようなことから、このページでは初心者の方でも簡単に作れるようなVisualBasicのプログラミングを皆さんが普段良く使いそうな住所録を例にとって紹介したいと思います。これからVisualBasicを始めようと言う方々に少しでも役に立てば幸いと思います。この住所録は、上の図のようにリレーショナルデータベースの機能を使ってAccessのテーブルにある住所データをVB側からSQL言語(データベース制御言語)を発行してトランザクション処理(変更、追加、削除)を行うことの出来る便利な住所録です。尚、この住所録を作るにはVisualBasic5.0とAccess97が必要です。それでは始めましょう!!


1.みっちゃん考案住所録の説明
1)  Accessのテーブルを作る。
テーブル(データを貯めておく所)をAccess97であらかじめ作っておきます。(Access97の詳細な使い方は別途入門書等で勉強してください)以下に、そのテーブルの内容を示します。

ID
名前
郵便番号
住所1
住所2
電話番号
FAX
携帯
E-Mail
親しい友人
その他の友人
1 山田太郎 112 東京都豊島区池袋3-11-2 マンション山田201 03-5555-6666 03-7777-8888 チェック印
2 鈴木花子 118 東京都杉並区永福4-5-6 03-1111-2222 チェック印

まず、表の1行目の項目(ID、名前、郵便番号、住所1、住所2、電話番号、FAX、携帯、Mail、親しい友人、その他の友人)をフィールドと呼びます。さらに、フィールドに対してID1、2に示す各行をレコード(実際の、友人知人の各データ行)と呼びます。では、フィールドの説明をします。IDはレコードナンバーを表します。同時に主キーに設定しフィールド型はオートナンバー型にします。名前、郵便番号はその名の通りです。フィールド型は両方ともテキスト型に設定します。住所1は番地まで、住所2はアパート/マンションを表します。フィールド型は両方ともテキスト型に設定します。
電話番号、FAXはその名の通りです。フィールド型は両方ともテキスト型に設定します。携帯は携帯電話、MailはE−Mailを表しています。フィールド型は両方ともテキスト型に設定します。親しい友人は小生の親しい友人、その他の友人は、小生の知人を表しています。ここのフィールドで”チェック印”と書いてあるのはフィールドのデータ型がYes/No型になっていることを表しています。
テーブルのデザインが完了したら、1レコード分データをテーブルに登録しておきましょう。尚、テキスト型のフィールドは”空白文字の許可”プロパティを”はい”に設定しておきましょう。

2) VBのフォームを作る
VBで作った入力フォームを以下に示します。

”最終レコード確認”は現在、テーブルにいくつまでのレコードが存在するかを表しています。”入力・編集・確認欄”は呼んで字のごとく入力と編集と確認が出来るテキストボックスとオプションボタンです。この中で、”親しい友人”と”その他の友人”の欄は適当に使う人の名前に変更してください。今は、オプションボタンになっていますが必要に応じてチェックボックスにしてください。”検索”のコマンドボタンは現在、テーブルに登録されている友人の情報を抽出する場合に使用します。条件として、名前のテキストボックスに抽出したい友人の名前を入力するのみ有効です。他のフィールド項目では検索できません。”登録・更新”のコマンドボタンは、テキストボックスに入力したデータを新規登録する場合や検索したデータを更新するが場合に使用します。”削除”ボタンはテーブルからレコードを削除する場合に使用します。削除したい名前をテキストボックスに入力して削除ボタンをクリックします。”クリア”のコマンドボタンは入力キャンセルに使います。以上がこの住所録フォームの説明です。また、プログラム上、このデータベースは以下の制限を設けています。

● 最大の登録レコード数は500です。(500以上登録したい場合は、プログラム上の変数設定値を変更してください)

● 新規登録する場合は、必ず”名前”、”郵便番号”、”住所1”の3項目が入力されていなければならない。この3項目のうち1つでも入力されていない状態で”登録・更新”ボタンが押された場合は怒られます。

● ”検索”及び”削除”は名前のテキストボックスに入力されることによって有功となります。他の項目に入力しても怒られますので気を付けてください。

最終的に小生は、VBの住所録フォームとは別に、以下のようにAccessでフォームを作り”住所録操作オプションメニュー”として、

■ テーブル表示
  登録テーブル表示

■ 一覧表示
  登録データ印刷用一覧

■ はがき表示
  はがき印刷用スタイル表示

■ はがき印刷

■ 一覧表印刷

を作り便利な住所録に仕上げました。


2.プログラミングとソースの公開

以下にVBのコード内容を示します。
'***************************************************************

'住所録テーブル管理プログラム( ファイル名:住所録.vbp 住所録フォーム.frm )

'アクセスJETデータベース( ファイル名:住所録.mdb )

' 日付 : 1997年8月28日

' 作成者 : kozupon.com

'***************************************************************

Dim CHECK As Integer

Dim ID(500) As Integer

Dim i As Integer

Dim n As Integer

Dim Action As Integer

Dim Db As Database

Dim Rs As Recordset

Private Sub Form_Load()

'*******************************************************************

'ACCSESSデータベースオープン処理

'*******************************************************************

Set Db = OpenDatabase("住所録.mdb")

'*******************************************************************

'データベースレコードセット(SQL文発行)

'*******************************************************************

Set Rs = Db.OpenRecordset("SELECT *" _

& "FROM 登録テーブル ")

'---------------------------------------------------------------

'ID登録レコードチェック

'---------------------------------------------------------------

Call ID_check

End Sub

Private Sub Command1_Click()

'*******************************************************************

'登録・更新処理

'*******************************************************************

'---------------------------------------------------------------

'テキストボックス空白チェック

'---------------------------------------------------------------

Call kuhaku_ck

If Action = 1 Then

GoTo owari

End If

'---------------------------------------------------------------

'レコード更新処理

'---------------------------------------------------------------

CHECK = 0

Call minyuryoku

Rs.MoveFirst

Do While Not Rs.EOF

If Rs!名前 = Text1.Text Then

CHECK = 1

Db.Execute "UPDATE 登録テーブル SET 名前 = '" & Text1.Text & "',郵便番号 = '" & Text2.Text & "',
住所1 = '" & Text3.Text & "',住所2 = '" & Text4.Text & "',電話番号 = '" & Text5.Text & "',FAX = '"

& Text6.Text & "',携帯 = '" & Text7.Text & "',Mail = '" & Text8.Text & "',親しい友人 = "

& Option1.Value & ",その他の友人 = " & Option2.Value & " WHERE ID = " & Rs!ID & " ; "

'------------------------------------------------------

'更新完了しました表示

'------------------------------------------------------

Action = MsgBox("更新完了!!", 0, "住所録")

End If

Rs.MoveNext

Loop

'---------------------------------------------------------------

'レコード新規追加処理

'---------------------------------------------------------------

If CHECK = 0 Then

Db.Execute "INSERT INTO 登録テーブル " _

& "(ID,名前,郵便番号,住所1,住所2,電話番号,FAX,携帯,Mail親しい友人,その他の友人) VALUES " _

& "( " & n + 1 & ", '" & Text1.Text & "', '" & Text2.Text & "', '" & Text3.Text & "', '" & Text4.Text &

"', '" & Text5.Text & "', '" & Text6.Text & "', '" & Text7.Text & "', '" & Text8.Text & "',

" & Option1.Value & ", " & Option2.Value & " ) ;"

'------------------------------------------------------

'追加完了しました表示

'------------------------------------------------------

Action = MsgBox("追加完了!!", 0, "住所録")

End If

'---------------------------------------------------------------

'テキストボックスクリア

'---------------------------------------------------------------

Call txt_clear

'---------------------------------------------------------------

'登録レコードチェック

'---------------------------------------------------------------

Set Rs = Db.OpenRecordset("SELECT *" _

& "FROM 登録テーブル ") 'データベース更新

Call ID_check

owari:

Call idou

End Sub

Private Sub Command3_Click()

'*******************************************************************

'レコード削除処理

'*******************************************************************

'---------------------------------------------------------------

'テキストボックスオール空白チェック

'---------------------------------------------------------------

Call kuhaku_ck2

If Action = 1 Then

GoTo owari2

End If

'---------------------------------------------------------------

'未知の名前チェック

'---------------------------------------------------------------

If Not Text1 = "" Then

Rs.MoveFirst

Do While Not Rs.EOF

If Rs!名前 = Text1 Then

GoTo sakuzyo

End If

Rs.MoveNext

Loop

Call rec_over

Call txt_clear

GoTo owari2

End If

'---------------------------------------------------------------

'レコード削除エラー

'---------------------------------------------------------------

Call sakuzyo_err

GoTo owari1

sakuzyo:

'---------------------------------------------------------------

'レコード削除開始

'---------------------------------------------------------------

Db.Execute "DELETE * " _

& "FROM 登録テーブル " _

& "WHERE 名前 = '" & Text1.Text & "';"

'------------------------------------------------------

'削除しました表示

'------------------------------------------------------

Action = MsgBox("削除完了!!", 0, "住所録")

owari1:

'---------------------------------------------------------------

'テキストボックスクリア

'---------------------------------------------------------------

Call txt_clear

'---------------------------------------------------------------

'登録レコードチェック

'---------------------------------------------------------------

Set Rs = Db.OpenRecordset("SELECT *" _

& "FROM 登録テーブル ") 'データベース更新

Call ID_check

owari2:

'---------------------------------------------------------------

'フォーカス移動

'---------------------------------------------------------------

Call idou

End Sub

Private Sub Command4_Click()

'*******************************************************************

'レコード検索処理

'*******************************************************************

'---------------------------------------------------------------

'登録レコードチェック

'---------------------------------------------------------------

Set Rs = Db.OpenRecordset("SELECT *" _

& "FROM 登録テーブル ") 'データベース更新

'---------------------------------------------------------------

'登録レコードチェック

'---------------------------------------------------------------

Rs.MoveFirst

n = 0

Do While Not Rs.EOF

ID(n) = Rs!ID

n = n + 1

Rs.MoveNext

Loop

'---------------------------------------------------------------

'テキストボックスオール空白チェック

'---------------------------------------------------------------

Call kuhaku_ck2

If Action = 1 Then

GoTo owari

End If

'---------------------------------------------------------------

'未知の名前チェック

'---------------------------------------------------------------

If Not Text1 = "" Then

Rs.MoveFirst

Do While Not Rs.EOF

If Rs!名前 = Text1 Then

GoTo kensaku

End If

Rs.MoveNext

Loop

Call rec_over

Call txt_clear

GoTo owari

End If

'---------------------------------------------------------------

'レコード検索エラー

'---------------------------------------------------------------

Call kensaku_err

GoTo owari

kensaku:

Set Rs = Db.OpenRecordset("SELECT * " _

& "FROM 登録テーブル " _

& "WHERE 名前 = '" & Text1.Text & "';")

Text1.Text = Rs!名前

If Not Rs!郵便番号 = "" Then

Text2.Text = Rs!郵便番号

End If

If Not Rs!住所1 = "" Then

Text3.Text = Rs!住所1

End If

If Not Rs!住所2 = "" Then

Text4.Text = Rs!住所2

End If

If Not Rs!電話番号 = "" Then

Text5.Text = Rs!電話番号

End If

If Not Rs!FAX = "" Then

Text6.Text = Rs!FAX

End If

If Not Rs!携帯 = "" Then

Text7.Text = Rs!携帯

End If

If Not Rs!Mail = "" Then

Text8.Text = Rs!Mail

End If

Option1.Value = Rs!親しい友人

Option2.Value = Rs!その他の友人

owari:

'---------------------------------------------------------------

'フォーカス移動

'---------------------------------------------------------------

Call idou

End Sub

Private Sub Command5_Click()

'******************************************************

'終了

'******************************************************

Db.Close

'------------------------------------------------------

'お疲れさまでした表示

'------------------------------------------------------

Action = MsgBox("お疲れさまでした!!", 0, "住所録")

End

End Sub

Private Sub Command6_Click()

Call txt_clear

Call idou

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)

'*******************************************************************

'リターンキーで次のテキストボックスへフォーカスを移す

'*******************************************************************

If KeyAscii = 13 Then

Text2.SetFocus

End If

End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)

'*******************************************************************

'リターンキーで次のテキストボックスへフォーカスを移す

'*******************************************************************

If KeyAscii = 13 Then

Text3.SetFocus

End If

End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)

'*******************************************************************

'リターンキーで次のテキストボックスへフォーカスを移す

'*******************************************************************

If KeyAscii = 13 Then

Text4.SetFocus

End If

End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)

'*******************************************************************

'リターンキーで次のテキストボックスへフォーカスを移す

'*******************************************************************

If KeyAscii = 13 Then

Text5.SetFocus

End If

End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)

'*******************************************************************

'リターンキーで次のテキストボックスへフォーカスを移す

'*******************************************************************

If KeyAscii = 13 Then

Text6.SetFocus

End If

End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)

'*******************************************************************

'リターンキーで次のテキストボックスへフォーカスを移す

'*******************************************************************

If KeyAscii = 13 Then

Text7.SetFocus

End If

End Sub

Private Sub Text7_KeyPress(KeyAscii As Integer)

'*******************************************************************

'リターンキーで次のテキストボックスへフォーカスを移す

'*******************************************************************

If KeyAscii = 13 Then

Text8.SetFocus

End If

End Sub

Sub kuhaku_ck()

'******************************************************

'テキストボックスの空白チェック

'******************************************************

Action = 0

If Text1 = "" Or Text2 = "" Or Text3 = "" Then

Action = MsgBox("入力の必要な部分に空白があります。", 48, "エラーメッセージ")

End If

End Sub

Sub kuhaku_ck2()

'******************************************************

'テキストボックスオール空白チェック

'******************************************************

Action = 0

If Text1 = "" And Text2 = "" And Text3 = "" And Text4 = "" And Text5 = ""

And Text6 = "" And Text7 = "" And Text8 = "" Then

Action = MsgBox("何も入力されていません。", 48, "エラーメッセージ")

End If

End Sub

Sub txt_clear()

'******************************************************

'テキストボックス消去

'******************************************************

Text1 = ""

Text2 = ""

Text3 = ""

Text4 = ""

Text5 = ""

Text6 = ""

Text7 = ""

Text8 = ""

End Sub

Sub kensaku_err()

'******************************************************

'検索エラー処理

'******************************************************

Action = 0

Action = MsgBox("名前でしか検索できません。", 48, "エラーメッセージ")

Call txt_clear

End Sub

Sub ID_check()

'******************************************************

'登録レコードチェック

'******************************************************

'******************************************************

'登録レコードカウント開始

'******************************************************

Rs.MoveFirst

n = 0

Do While Not Rs.EOF

ID(n) = Rs!ID

n = n + 1

Rs.MoveNext

Loop

'******************************************************

'最終レコードチェック

'******************************************************

Rs.MoveFirst

Rs.MoveLast

Label10.Caption = Rs!ID

n = Rs!ID

End Sub

Sub rec_over()

'******************************************************

'未知のレコードエラー処理

'******************************************************

Action = 0

Action = MsgBox("未知のレコードです。", 48, "エラーメッセージ")

Call txt_clear

End Sub

Sub sakuzyo_err()

'******************************************************

'削除エラー処理

'******************************************************

Action = 0

Action = MsgBox("名前でしか削除できません。", 48, "エラーメッセージ")

Call txt_clear

End Sub

Sub idou()

'******************************************************

'フォーカスをTEXT1へ移動

'******************************************************

Text1.SetFocus

End Sub

Sub minyuryoku()

'******************************************************

'テキストボックスの未入力処理(空白書き込み)

'******************************************************

If Text4.Text = "" Then

Text4 = ""

End If

If Text5.Text = "" Then

Text5 = ""

End If

If Text6 = "" Then

Text6 = ""

End If

If Text7.Text = "" Then

Text7 = ""

End If

If Text8.Text = "" Then

Text8 = ""

End If

End Sub

コード内容が不明な所はご容赦ください。ここではVBのテキストボックス、コマンドボタン等プロパティーの部分は記載しません。
コードの内容はコメントを参照してコーディングしてください。

以上


 
 
 



Copyright 2005 Kozupon.com.