アクセス解析
FC2ブログ
                    
パソコン教室 COM-IT TOP > Access

みゅら~のVBA入門第11回目

「みゅら~」のVBA入門・第11回目
体調管理アプリ-Access
皆さん遅れましたが、明けましておめでとうございます「みゅら~」です。
「みゅら~」のVBA入門、今年も宜しくお願いします。
「出張(たび)の途中のコラム」

◎栃木編
 皆さん栃木県といって、最初に何を思いますか?
「日光東照宮」「華厳の滝」「中禅寺湖」「日光江戸時代村」「スクエアーワールド」
「日光猿軍団」そして「宇都宮餃子」、生産量日本一の「とちおとめ」(苺)でしょうか?
「みゅら〜」は「日光東照宮」には、3度見物に行っていますが、
将軍謁見の場は1畳
1万石と言われ、1万石程度の大名は、一番後ろの席だったそうです。
後は「見猿、聞か猿、言は猿」は今も思い出に残っています。(全て綺麗でした)
記憶は定かではないのですが、「中禅寺湖」には、
「中善寺」と言う「縁むすび」の神社があったと思います。
出会いを希望される方は、お祈りしてみてはどうでしょうか?

ちなみに不信心の「みゅら〜」にはご縁がなかったのですが・・・
栃木県は源平屋島の合戦の英雄で弓の名手「那須与一」ゆかりの地でもあります。
毎年8月ぐらいに「与一祭り」があり、
近隣の小学校6年生が「鎧武者」で行進するのは、圧巻です。
 そして「みゅら〜」と言えば食べ物ですが、なんといっても「餃子」です。
一番美味しいと感じたお店は、餃子以外何もありません。
(ビールもライスもありません)「焼き餃子」と「水餃子」のみですが、
「焼き」2人前と「水」1人前が「みゅら〜」の定番でした。とても美味しかった。(又食べたいです)
本場、中国での餃子のタレは「酢」が7で「醤油」が3だそうです。
皆様も一度ご賞味下さい。
 
閑話休題
 
 さて今回から数回に分けてAccess VBAでアプリをやってみましょう!!
概略は12名のメンバーがそれぞれ体調を選択・入力し、
スタッフが一括して閲覧できる「プチ・クライアント/サーバーシステムです」

まずデータベースを作成しましょう。

「ConditionData」テーブルと「MenberMaster」を作成します。
 
 
以下は、MemberMasterです。

みゅら〜VBA入門11回1

以下はConditionDataです。

みゅら〜VBA入門11回2

各カラムは全てテキストで設定しています。
特にMemberID等コードに関する事項は、今後の「JANコード」の普及を考えて行う必要があると思われます。
データベース名を付けて任意のフォルダーに保存してください。
画面は画面・DBはDBで分けて設計されています。
① C:\Users\user\Documents\MemberID.iniを作成し、MemberIDを登録します。
注)MemberIDを入力しましたら、エンターは押さずに、保存してください。
  (誤動作を起こします)
② 以下の画面を作成し、名前を付けて保存してください。
 
みゅら〜VBA入門11回3 
 
③以下のロジックを記述して下さい
Option Explicit
Option Compare Database
Dim IdBuff      As String
Dim IdName      As String
Dim DateBuff    As Date
Dim Condition   As String
Dim Remarks     As String
Dim objAccess
Dim objDB
Dim strSql
Dim objRS
Dim cmbItemNo   As Integer
Dim StartTime   As String
Dim EndTime     As String
 
Private Sub cmdSave_Click()
    Dim count       As Variant
   
    If (コンボ20.Value = "") Then
        MsgBox ("調子は必ず選択してください")
        Exit Sub
    End If
   
    Set objAccess = CreateObject("Access.Application")
 
    objAccess.OpenCurrentDatabase ("先に作成したデータベースを絶対パスを指定してください")
 
    Set objDB = objAccess.CurrentDb
       
    strSql = "SELECT COUNT(*) AS 件数 FROM ConditionData " & _
             "WHERE MemberID = " & "'" & IdBuff & "'" & _
             " AND TodayDate = " & "'" & DateBuff & "'"
   
    Set objRS = objDB.OpenRecordset(strSql)
 
    Condition = コンボ15.Value
'    Remarks = テキスト備考.Text
    count = objRS("件数")
 
    If (count = 0) Then
        strSql = "INSERT INTO ConditionData ( " & _
                            "MemberID , " & _
                             "TodayDate , " & _
                             "StartTime , " & _
                             "EndTime , " & _
                             "Condition, " & _
                             "Remarks ) " & _
                             "VALUES(" & _
                                     "'" & IdBuff & "'" & "," & _
                                     "'" & DateBuff & "'" & "," & _
                                     "'" & StartTime & "'" & "," & _
                                     "'" & EndTime & "'" & "," & _
                                     " '" & Condition & "'," & _
                                     "'" & Remarks & "'" & " )"
        objDB.Execute strSql
 
    Else
        strSql = "UPDATE ConditionData SET " & _
                   " StartTime = '" & StartTime & "' , " & _
                   " EndTime = '" & EndTime & "' , " & _
                   " Condition = " & "'" & Condition & "' , " & _
                   " Remarks = " & "'" & Remarks & "'" & _
                   " WHERE MemberID = " & "'" & IdBuff & "'" & _
                   " AND TodayDate = " & "'" & DateBuff & "'"
        objDB.Execute strSql
    End If
   
    objDB.Close
 
    objAccess.CloseCurrentDatabase
 
    Set objDB = Nothing
    Set objAccess = Nothing
End Sub
 
Private Sub Form_Activate()
    Dim Fno         As Integer
    Dim Name        As String
    Dim cnn         As Object
    Dim rst         As Object
    Dim mdbPath     As String
    Dim cnt         As Long
    Dim NameBuff    As String
    Dim Condition   As String
    Dim Remarks     As String
    Dim idx         As Integer
   
    Fno = FreeFile
    Open "C:\Users\user\Documents\MemberID.ini" For Input As #Fno
    Do Until EOF(Fno)
        Line Input #Fno, IdBuff
    Loop
    Close #Fno
    Form_フォーム1.ラベル1.Caption = IdBuff
   
   
    mdbPath = "先に作成したデータベースを絶対パスを指定してください"
   
    Set cnn = CreateObject("ADODB.connection")
   
    cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
    cnn.Open mdbPath
       
    Set rst = cnn.Execute("SELECT MemberID,MemberName FROM MemberMaster WHERE MemberID = " & "'" & IdBuff & "'")
    For cnt = 1 To rst.Fields.count
        NameBuff = rst.Fields(1)
    Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
 
    Form_フォーム1.ラベル3.Caption = NameBuff
 
    Set objAccess = CreateObject("Access.Application")
 
    DateBuff = Date
 
    objAccess.Visible = True
    objAccess.OpenCurrentDatabase ("先に作成したデータベースを絶対パスを指定してください")
 
    Set objDB = objAccess.CurrentDb
 
    Set objRS = objDB.OpenRecordset("SELECT StartTime,EndTime,Condition,Remarks FROM ConditionData WHERE MemberID = " & "'" & IdBuff & "'" & " AND TodayDate = '" & DateBuff & "'")
 
    Do Until objRS.EOF = True
        StartTime = objRS("StartTime")
        EndTime = objRS("EndTime")
        Condition = objRS("Condition")
        Remarks = objRS("Remarks")
        objRS.MoveNext
    Loop
 
    objRS.Close
    objDB.Close
 
    objAccess.CloseCurrentDatabase
 
    Set objRS = Nothing
    Set objDB = Nothing
    Set objAccess = Nothing
    Form_フォーム1.コンボ15.Value = Condition
    Form_フォーム1.コンボ20.Value = StartTime
    Form_フォーム1.コンボ22.Value = EndTime
    Form_フォーム1.テキスト備考 = Remarks
    Form_フォーム1.ラベル5.Caption = DateBuff
    DateBuff = Date
 
End Sub
 
Private Sub コンボ15_Click()
    Condition = コンボ15.Value
End Sub
 
Private Sub コンボ20_Click()
    StartTime = コンボ20.Value
End Sub
 
Private Sub コンボ22_Click()
    EndTime = コンボ22.Value
End Sub
 
Private Sub テキスト備考_KeyPress(KeyAscii As Integer)
End Sub
 
Private Sub テキスト備考_KeyUp(KeyCode As Integer, Shift As Integer)
 
End Sub
 
Private Sub テキスト備考_LostFocus()
    Remarks = テキスト備考.Text
End Sub
 
Private Sub ラベル18_Click()
    DateBuff = DateBuff - 1
    Form_フォーム1.コンボ15.Value = ""
    Form_フォーム1.コンボ20.Value = ""
    Form_フォーム1.コンボ22.Value = ""
    Form_フォーム1.テキスト備考 = ""
   
    Condition = ""
    Remarks = ""
    StartTime = ""
    EndTime = ""
   
    Set objAccess = CreateObject("Access.Application")
 
    objAccess.Visible = True
 
    objAccess.OpenCurrentDatabase ("先に作成したデータベースを絶対パスを指定してください")
 
    Set objDB = objAccess.CurrentDb
 
    Set objRS=objDB.OpenRecordset("SELECT StartTime,EndTime,Condition,Remarks FROM ConditionData WHERE MemberID = " & "'" & IdBuff & "'" & " AND TodayDate = '" & DateBuff & "'")
 
    Do Until objRS.EOF = True
        StartTime = objRS("StartTime")
        EndTime = objRS("EndTime")
        Condition = objRS("Condition")
        Remarks = objRS("Remarks")
        objRS.MoveNext
    Loop
 
    objRS.Close
    objDB.Close
 
    objAccess.CloseCurrentDatabase
 
    Set objRS = Nothing
    Set objDB = Nothing
    Set objAccess = Nothing
    Form_フォーム1.コンボ15.Value = Condition
    Form_フォーム1.コンボ20.Value = StartTime
    Form_フォーム1.コンボ22.Value = EndTime
    Form_フォーム1.テキスト備考 = Remarks
    Form_フォーム1.ラベル5.Caption = DateBuff
   
End Sub
 
Private Sub ラベル19_Click()
    DateBuff = DateBuff + 1
   
    Form_フォーム1.コンボ15.Value = ""
    Form_フォーム1.コンボ20.Value = ""
    Form_フォーム1.コンボ22.Value = ""
    Form_フォーム1.テキスト備考 = ""
    Condition = ""
    Remarks = ""
    StartTime = ""
    EndTime = ""
   
    Set objAccess = CreateObject("Access.Application")
 
    objAccess.Visible = True
 
    objAccess.OpenCurrentDatabase("先に作成したデータベースを絶対パスを指定してください")
 
    Set objDB = objAccess.CurrentDb
 
    SetobjRS=objDB.OpenRecordset("Select StartTime,EndTime,Condition,Remarks FROM ConditionData WHERE MemberID = " & "'" & IdBuff & "'" & " AND TodayDate = '" & DateBuff & "'")
 
    Do Until objRS.EOF = True
        StartTime = objRS("StartTime")
        EndTime = objRS("EndTime")
        Condition = objRS("Condition")
        Remarks = objRS("Remarks")
        objRS.MoveNext
    Loop
 
    objRS.Close
    objDB.Close
 
    objAccess.CloseCurrentDatabase
 
    Set objRS = Nothing
    Set objDB = Nothing
    Set objAccess = Nothing
    Form_フォーム1.コンボ15.Value = Condition
    Form_フォーム1.コンボ20.Value = StartTime
    Form_フォーム1.コンボ22.Value = EndTime
    Form_フォーム1.テキスト備考 = Remarks
    Form_フォーム1.ラベル5.Caption = DateBuff
 
End Sub
 
2行にまたっがているところは1行で行なって下さい。
次回はスタッフ側の作成を行いたいと思います。





COM-ITインストラクター募集中
たくさんのご応募お待ちしております。 なお定員になり次第、募集は締め切らせていただきます。
パンフレットはこちらから

いつも読んでいただきありがとうございます^^
ランキングに参加してます!!
よろしかったら、ポチっとお願いします。
   ↓ ↓ ↓ 


にほんブログ村 地域生活(街) 北海道ブログ 札幌情報へ

COM-ITインストラクター募集中
就労継続支援A型(雇用型)事業所を利用される方を募集しております。 見学など随時お受けしておりますので、まずはお気軽にご連絡ください。 ご応募お待ち申し上げております。
(担当:後藤)

パンフレットはこちらから
カレンダー
03 | 2019/04 | 05
- 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 - - - -
com-itの所在地・連絡先
所在地はこちら
〒001-0023 北海道札幌市北区北23条西4丁目1−12鉄北ビル2F
TEL 011-738-7551
FAX 011-738-7552

ランキングに参加しています!
ブログランキングに参加してます。 お手数ですが、下記バナーをぽちっと して頂けたらすごくうれしいです。
  にほんブログ村 地域生活(街) 北海道ブログ 札幌情報へ
最新記事
カテゴリ
月別アーカイブ
管理画面
RSSリンクの表示
QRコード
QR
検索フォーム