【VBA】ユーザー目線で開発する４

目次

ユーザーフォームに機能を実装する

初冷房つけました。jimです。どうも✋

さっそく【VBA】ユーザー目線で開発する３の続きいきます。

用意したユーザーフォームを実行して表示してみます。

はい、テキストボックスに文字を入力することはできますが、ボタンを押しても何も起こりません。

今回は、これらのオブジェクトに機能を実装していきます👈

とりあえず、VBEのユーザーフォームを右クリックし『コードの表示』を選択。コードを表示します。（もしくはF7）

次に、下図の赤枠を変更して、３つのプロシージャを用意します。（手打ちでもOK）

↓の３つです。

1С (Запрос)
1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Private Sub CommandButton1_Click()
 
End Sub
 
Private Sub CommandButton2_Click()
 
End Sub
 
Private Sub UserForm_Initialize()
 
End Sub

それではこれから順番に記述していきます。

初期化

まずは『UserForm_Initialize』からです。

ユーザーフォームが表示される時に実行されます。

どんな機能を実装するかというと、まずユーザーフォームのキャプションにユーザー名を入力します。

次に、データベースにキャプション名と同じユーザー名があるかを問い合わせます。

そして、ユーザー名があった場合、項目がNullでなければテキストボックスにデータを入力。っと、いった感じのものです。

1С (Запрос)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Const dbName = "\\共有サーバー\適当.accdb"
Private Sub UserForm_Initialize()
Dim adoCn, adoRs As Object
Dim sqlStr As Object
Dim WshNetworkObject As Object
    Set WshNetworkObject = CreateObject("WScript.Network")
    UserForm1.Caption = WshNetworkObject.username
    Set adoCn = CreateObject("ADODB.Connection")
    Set adoRs = CreateObject("ADODB.Recordset")
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=" & dbName & ";"
    sqlStr = "SELECT * FROM 個人設定 WHERE ユーザー名 ='" & UserForm1.Caption & "' ;"
    adoCn.Open sqlStr, adoCn
    If adoRs.EOF = True Then
        If IsNull(adoRs!名字) = False Then TextBox1.Value = adoRs!名字
        If IsNull(adoRs!名前) = False Then TextBox1.Value = adoRs!名前
        If IsNull(adoRs!メールアドレス) = False Then TextBox1.Value = adoRs!メールアドレス
        If IsNull(adoRs!保存先) = False Then TextBox1.Value = adoRs!保存先
    End If
    adoRs.Close
    adoCn.Close
End Sub

挿入と更新

次は『CommandButton1_Click』です。

初期化同様に、ユーザーフォームのキャプション名から、データの有無を問い合わせます。

データがある場合はUPDATEのSQL文、ない場合はINSERTのSQL文を作成。

最後に、実行してユーザーフォームを閉じます。

1С (Запрос)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Sub CommandButton1_Click()
Dim adoCn, adoRs As Object
Dim sqlStr As Object
    Set adoCn = CreateObject("ADODB.Connection")
    Set adoRs = CreateObject("ADODB.Recordset")
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=" & dbName & ";"
    sqlStr = "SELECT * FROM 個人設定 WHERE ユーザー名 ='" & UserForm1.Caption & "' ;"
    adoCn.Open sqlStr, adoCn
    If adoRs.EOF = True Then
        sqlStr = "INSERT INTO 個人設定"
        sqlStr = sqlStr & "(ユーザー名,名字,名前,メールアドレス,保存先)"
        sqlStr = sqlStr & " VALUES ('" & UserForm1.Caption & "'"
        sqlStr = sqlStr & " ,'" & TextBox1.Value & ","
        sqlStr = sqlStr & " ,'" & TextBox2.Value & ","
        sqlStr = sqlStr & " ,'" & TextBox3.Value & ","
        sqlStr = sqlStr & " ,'" & TextBox4.Value & ",) ;"
    Else
        sqlStr = "UPDATE 個人設定"
        sqlStr = sqlStr & " SET 名字 ='" & TextBox1.Value & ","
        sqlStr = sqlStr & " , 名前 ='" & TextBox2.Value & ","
        sqlStr = sqlStr & " , メールアドレス ='" & TextBox3.Value & ","
        sqlStr = sqlStr & " , 保存先 ='" & TextBox4.Value & ","
        sqlStr = sqlStr & " WHERE ユーザー名 ='" & UserForm1.Caption & "' ;"
    End If
    adoRs.Close
    adoRs.Open sqlStr, adoCn
    adoRs.Close
    adoCn.Close
    Unload UserForm1
    MsgBox "挿入/更新が完了しました", vbOKOnly, "完了"
End Sub

削除

最後は『CommandButton2_Click』です。

これは単純に『キャプション名と同じデータがあれば削除する。』というSQL文を実行し、ユーザーフォームを閉じます。

挿入/更新も削除もですが、最後にユーザーフォームを非表示じゃなく閉じるにしたのは、テキストボックスをリセットするコードを削りたかったからです。

1С (Запрос)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton2_Click()
Dim adoCn, adoRs As Object
Dim sqlStr As Object
    Set adoCn = CreateObject("ADODB.Connection")
    Set adoRs = CreateObject("ADODB.Recordset")
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=" & dbName & ";"
    sqlStr = "DELETE FROM 個人設定"
    sqlStr = sqlStr & " WHERE ユーザー名 ='" & UserForm1.Caption & "' ;"
    adoCn.Open sqlStr, adoCn
    adoRs.Close
    adoCn.Close
    Unload UserForm1
    MsgBox "削除が完了しました", vbOKOnly, "完了"
End Sub

 

実装まとめ

1С (Запрос)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Option Explicit
Const dbName = "\\共有サーバー\適当.accdb"
Private Sub CommandButton1_Click()
Dim adoCn, adoRs As Object
Dim sqlStr As Object
    Set adoCn = CreateObject("ADODB.Connection")
    Set adoRs = CreateObject("ADODB.Recordset")
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=" & dbName & ";"
    sqlStr = "SELECT * FROM 個人設定 WHERE ユーザー名 ='" & UserForm1.Caption & "' ;"
    adoCn.Open sqlStr, adoCn
    If adoRs.EOF = True Then
        sqlStr = "INSERT INTO 個人設定"
        sqlStr = sqlStr & "(ユーザー名,名字,名前,メールアドレス,保存先)"
        sqlStr = sqlStr & " VALUES ('" & UserForm1.Caption & "'"
        sqlStr = sqlStr & " ,'" & TextBox1.Value & ","
        sqlStr = sqlStr & " ,'" & TextBox2.Value & ","
        sqlStr = sqlStr & " ,'" & TextBox3.Value & ","
        sqlStr = sqlStr & " ,'" & TextBox4.Value & ",) ;"
    Else
        sqlStr = "UPDATE 個人設定"
        sqlStr = sqlStr & " SET 名字 ='" & TextBox1.Value & ","
        sqlStr = sqlStr & " , 名前 ='" & TextBox2.Value & ","
        sqlStr = sqlStr & " , メールアドレス ='" & TextBox3.Value & ","
        sqlStr = sqlStr & " , 保存先 ='" & TextBox4.Value & ","
        sqlStr = sqlStr & " WHERE ユーザー名 ='" & UserForm1.Caption & "' ;"
    End If
    adoRs.Close
    adoRs.Open sqlStr, adoCn
    adoRs.Close
    adoCn.Close
    Unload UserForm1
    MsgBox "挿入/更新が完了しました", vbOKOnly, "完了"
End Sub
Private Sub CommandButton2_Click()
Dim adoCn, adoRs As Object
Dim sqlStr As Object
    Set adoCn = CreateObject("ADODB.Connection")
    Set adoRs = CreateObject("ADODB.Recordset")
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=" & dbName & ";"
    sqlStr = "DELETE FROM 個人設定"
    sqlStr = sqlStr & " WHERE ユーザー名 ='" & UserForm1.Caption & "' ;"
    adoCn.Open sqlStr, adoCn
    adoRs.Close
    adoCn.Close
    Unload UserForm1
    MsgBox "削除が完了しました", vbOKOnly, "完了"
End Sub
Private Sub UserForm_Initialize()
Dim adoCn, adoRs As Object
Dim sqlStr As Object
Dim WshNetworkObject As Object
    Set WshNetworkObject = CreateObject("WScript.Network")
    UserForm1.Caption = WshNetworkObject.username
    Set adoCn = CreateObject("ADODB.Connection")
    Set adoRs = CreateObject("ADODB.Recordset")
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=" & dbName & ";"
    sqlStr = "SELECT * FROM 個人設定 WHERE ユーザー名 ='" & UserForm1.Caption & "' ;"
    adoCn.Open sqlStr, adoCn
    If adoRs.EOF = True Then
        If IsNull(adoRs!名字) = False Then TextBox1.Value = adoRs!名字
        If IsNull(adoRs!名前) = False Then TextBox1.Value = adoRs!名前
        If IsNull(adoRs!メールアドレス) = False Then TextBox1.Value = adoRs!メールアドレス
        If IsNull(adoRs!保存先) = False Then TextBox1.Value = adoRs!保存先
    End If
    adoRs.Close
    adoCn.Close
End Sub

これでDBの読み書きがユーザーフォームで出来るようになりました。

次回は、このDBを使った『例えばツール』を紹介します。んじゃまたね✋

 

Access,SQL,VBA,データベース,プログラミング

Posted by jim