簡易住所録

簡易住所録プログラムVer1.02例完成版

ついに完成しました、簡易住所録プログラム、長かった・・・・。
時間を掛けたからにはそれなりのものに仕上がっているので、期待してください。
Ver1.02ではレコードの削除や最適化に可能になりました。
ただこのプログラム例はインデントしてないので見にくいかも、勘弁してね・・・
万が一バグが見つかったらメールにて連絡していただけるとうれしいです。

まだ詳しい説明はありませんが、分かる人なら、コーディング内の説明メッセージだけで十分理解可能だと思います。
またコーディングの中にある線は大きな区切りを表しています。
注意する点としてファイルの指定先を必ず変更すること！替えないとエラーが生じます。

プログラム例

'変数をPrivate宣言する
Private Type kosen 'ユーザー定義型

name As String * 20 '名
sex As String '性別
age As Integer '年齢
post As String '〒
address As String * 40 '住所
telban As String '℡番号

End Type

Private keiei As kosen 'ユーザー定義型による変数
Private TargetRec As Integer '現在表示しているレコード
Private MaxRec As Integer '総登録件数

'定数の宣言　保存場所変更を簡単にするため定数宣言
Const DataFile As String = "c:\temp\address.dt" 'もとのファイル
Const DataFile2 As String = "c:\My Documents\ichiji.dt" '一時ファイル

'サブプロシージャGetData()　各データをメンバに獲得する
Sub GetData()

With keiei

'各メンバにデータを格納
.name = Text1.Text '氏名
.sex = Combo1.ListIndex '性別
.age = Combo2.ListIndex '年齢
.post = Text2.Text '〒
.address = Text3.Text '住所
.telban = Text4.Text '℡

End With

Text1.SetFocus 'テキスト1へSetFocus

End Sub

'サブプロシージャOutData() 各メンバ各コントロールにを出力する
Sub OutData()

Text1.Text = keiei.name
Text2.Text = keiei.post
Text3.Text = keiei.address
Text4.Text = keiei.telban
Combo1.ListIndex = keiei.sex
Combo2.ListIndex = keiei.age

End Sub

'サブプロシージャNewData()　クリア
Sub NewData()

'各コントロールの内容をクリア
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Combo1.ListIndex = 0 '男性へ
Combo2.ListIndex = 0 '1歳へ

End Sub

'後方一致検索
Private Sub Command1_Click()

'先頭のレコードの時は何もしない
If TargetRec = 1 Or TargetRec = 0 Then
Exit Sub '常にこのプロシージャを抜け出す
End If

'TargetRecを一つ減らして表示レコードの一つ前のレコードを表示
TargetRec = TargetRec - 1
Get #1, TargetRec, keiei '各データをメンバからそれぞれ取得

OutData 'サブプロシージャOutDataへ

'今の総レコードと今のターゲットレコードをを表示
Label6.Caption = Trim(Str(TargetRec)) & "/" & Trim(Str(MaxRec))
Label7.Caption = Trim(Str(TargetRec)) & "件目です"

Text1.SetFocus 'テキスト1へSetFocus

End Sub

'携帯専用コマンドボタン
Private Sub Command10_Click()

Text4.Text = "090" '携帯の頭三桁は090
Text4.SetFocus 'テキスト1へSetFocus

End Sub

'前方一致検索
Private Sub Command2_Click()

Select Case TargetRec

'最後まで達すると何もしない
Case Is = MaxRec
Exit Sub 'このプロシージャを抜け出す

'MaxRecよりもTargetRecが小さいなら表示レコードの一つ次のレコードを表示
'つまりMaxRec以上はなにも起こらない
Case Is < MaxRec

TargetRec = TargetRec + 1
Get #1, TargetRec, keiei '各データをメンバからそれぞれ取得

OutData 'サブプロシージャOutDataへ

'今の総レコードと今のターゲットレコードをを表示
Label6.Caption = Trim(Str(TargetRec)) & "/" & Trim(Str(MaxRec))
Label7.Caption = Trim(Str(TargetRec)) & "件目です"

End Select

Text1.SetFocus 'テキスト1へSetFocus

End Sub

'終了およびファイルのクローズ
Private Sub Command3_Click()

'確認メッセージ
If MsgBox(DataFile & "に保存しファイルを閉じます。" & vbCrLf & "よろしいですか？", vbYesNo) = vbYes Then

Close #1 'ファイルを閉じる
End 'プログラムの終了

Else

Text1.SetFocus 'テキスト1へSetFocus
Exit Sub 'このプロシージャを抜け出す

End If

End Sub

'クリア
Private Sub Command4_Click()

'TargetRec = 1の時はクリアできない
If TargetRec = 1 Then

Exit Sub 'このプロシージャを抜け出す

Else

NewData 'サブプロシージャNewDataへ
Text1.SetFocus 'テキスト1へSetFocus

End If

End Sub

'登録　但しこのコマンドボタンは新規登録のみで変更はできない
Private Sub Command5_Click()

'名前が未入力の場合
If Trim(Text1.Text) = "" Then

MsgBox ("名前が未入力です。")
Exit Sub 'このプロシージャを抜け出す

End If

Dim flag As Boolean '重複レコードチェックフラグ
Dim i As Integer 'ループ専用フラグ

'レコードの重複チェック
flag = False
For i = 1 To MaxRec Step 1

'レコードを読み出す
Get #1, i, keiei

'氏名の後ろの余分なスペースを削除して比較する
If Trim(Text1.Text) = Left(keiei.name, InStr(keiei.name, " ") - 1) Then

flag = True
Exit For

End If

Next i

If flag = True Then

Label7.Caption = "その人物は既に潜在するためレコード重複です" & vbCrLf & "変更する場合は変更ボタンを押してください。"

'重複レコードだったら
If TargetRec = 1 Then

'TargetRec = 1の時はクリアしない
Exit Sub 'このプロシージャを抜け出す

Else

NewData 'サブプロシージャNewDataへ
Text1.SetFocus 'テキスト1へSetFocus
Exit Sub 'このプロシージャを抜け出す

End If

End If

MaxRec = MaxRec + 1
GetData 'サブプロシージャGetDataへ

Put #1, MaxRec, keiei

'今の総レコードと今のターゲットレコードをを表示
Label6.Caption = Trim(Str(MaxRec)) & "/" & Trim(Str(MaxRec))
Label7.Caption = Trim(Str(MaxRec)) & "件目に登録されました。"

MsgBox ("登録しました。")

'登録したということは、1件以上なので以下のコマンドボタンを使えるようにする
Command3.Enabled = True '終了
Command7.Enabled = True '変更
Command8.Enabled = True '最適化/削除

End Sub

'完全一致による人名検索
Private Sub Command6_Click()

Dim i As Integer 'ループフラグ

For i = 1 To MaxRec '1からMaxRecまで読み込む

Get #1, i, keiei

'重複レコードだったら存在するので、そのレコードデータを読み込む
If Trim(Text1.Text) = Left(keiei.name, InStr(keiei.name, " ") - 1) Then

OutData 'サブプロシージャOutDataへ

Label7.Caption = "検索結果あり、表示します。"
Label6.Caption = "検索結果" & "/" & Trim(Str(MaxRec))
Text1.SetFocus 'テキスト1へSetFocus
Exit Sub 'このプロシージャを抜け出す

Else
'関係ないレコードは飛ばすということ
End If

Next i

'検索結果がない場合
Label7.Caption = "検索結果なし、存在しません。"
Text1.SetFocus 'テキスト1へSetFocus

End Sub

'変更　但し名前変更不可
Private Sub Command7_Click()

Text1.SetFocus 'テキスト1へSetFocus

'確認メッセージ
If MsgBox("その人物のデータを変更します、よろしいですか？", vbYesNo) = vbNo Then

Exit Sub 'このプロシージャを抜け出す

Else

'簡単に言うと重複レコードだったら名前が等しいということ　= 変更できる
If Trim(Text1.Text) = Left(keiei.name, InStr(keiei.name, " ") - 1) Then

GetData 'サブプロシージャGetDataへ

Put #1, TargetRec, keiei '新たに今のTargetRecに書き換える

MsgBox ("変更しました。")

Else

'もしも名前を変えた場合
MsgBox ("名前の変更は認められません！")

Get #1, TargetRec, keiei '変更されていたら、もとのレコードをゲット

OutData 'サブプロシージャOutDataへ

Exit Sub 'このプロシージャを抜け出す

End If

End If

End Sub

'ファイルの削除および最適化
Private Sub Command8_Click()

'MaxRec = 1の時に削除しようとしたら
If MaxRec = 1 Then

'確認メッセージ
If MsgBox("これを実行すると全てのデータが消えたことになります。ファイルを削除し強制終了して最初からデータを作り直します。よろしいですか？", vbYesNo) = vbNo Then

Exit Sub 'このプロシージャを抜け出す

Else

Close #1 'ファイルを閉じ
Kill DataFile 'そのファイルを削除し
End '終了する

End If

End If

Dim j As Integer 'ループ専用フラグ
Dim k As Integer '仮のMaxRec

k = 0

'確認メッセージ
If MsgBox("その人物のデータを削除します、よろしいですか？", vbYesNo) = vbNo Then

Text1.SetFocus 'テキスト1へSetFocus
Exit Sub 'このプロシージャを抜け出す

Else

'ありえない値をkeiei.ageに代入
keiei.age = -1
Put #1, TargetRec, keiei

'新しい(一時)ファイルのオープン
Open DataFile2 For Random As #2

For j = 1 To MaxRec

'元ファイルの読み出し
Get #1, j, keiei

If keiei.age = -1 Then 'keiei.age=-1なら
'それレコードは飛ばす
Else

'有効レコードのみ一時ファイルに書き込む
k = k + 1
Put #2, k, keiei

End If

Next j

'元ファイルクローズ
Close #1

'一時ファイルクローズ
Close #2

'元ファイル削除
Kill DataFile

'一時ファイルの名前を元ファイルの名前に変更する
Name DataFile2 As DataFile

Form_Load 'フォームをロードしてやる
MsgBox ("削除し最適化しました。")

End If

End Sub

'フォームロード時の処理
Private Sub Form_Load()

'以下のコマンドボタンはエラー対処のため使えないようにしておく
Command5.Enabled = False '登録
Command6.Enabled = False '人名検索
Command7.Enabled = False '変更

'コンボボックスにデータを追加
'性別
With Combo1

.AddItem "男性"
.AddItem "女性"

End With

'年齢　とりあえず100歳まで
With Combo2

For i = 1 To 100

.AddItem i '100歳まで

Next i

End With

'もし定数DataFileが存在しないなら
If Dir(DataFile) = "" Then

'コンボボックスのエラーをふせぐため1件以上登録するまで終了ボタンは使えない
Command3.Enabled = False

'ランダムモードで開きデータを作る　→　新規作成
Open DataFile For Random As #1

'白紙画面の表示
NewData 'サブプロシージャNewDataへ

'変数の初期設定
TargetRec = 0
MaxRec = 0
Label6.Caption = "1/新規"
Label7.Caption = "データは存在しません"

'データが既に存在するのなら
Else

MaxRec = 0 'MaxRecの初期化
Open DataFile For Random As #1

Do Until EOF(1) 'ファイルの終わりまで読み込む

MaxRec = MaxRec + 1
Get #1, MaxRec, keiei

Loop

'最初のデータを画面に表示
TargetRec = 1

Get #1, TargetRec, keiei
OutData 'サブプロシージャOutDataへ

'今の総レコードと今のターゲットレコードをを表示
Label6.Caption = Trim(Str(TargetRec)) & "/" & Trim(Str(MaxRec))
Label7.Caption = "先頭のレコードです"

End If

'MaxRecが0ということはレコードが存在しないので
'最適化や削除、変更は行う必要がない
If MaxRec = 0 Then

Command7.Enabled = False
Command8.Enabled = False

Else

Command7.Enabled = True
Command8.Enabled = True

End If

End Sub

'Text1_Change()
Private Sub Text1_Change()

'以下の条件で使えるか使えないか判断する
If Text1.Text = "" Or keiei.name = "" Then

Command5.Enabled = False '登録
Command6.Enabled = False '人名検索

Else

Command5.Enabled = True
Command6.Enabled = True

End If

End Sub