【広告】

しのちーチャンネル

エクセルマクロで作った透析データベース～注射薬フォーム

このフォームは患者さんに使う注射薬を確認編集するための物です。

コンボボックスに注射の一覧が表示されその中から選ぶことで変更します。

コンボボックスへ読み込む注射薬の一覧はエクセルのワークシートに記載しています。 注射薬に限らず、ほぼすべてのフォームのリストボックスやコンボボックスへ読み込むデータはまとめてワークシートに記載しています。各フォームはそこから選択肢であるリストを読み込んでいます。こうすることで一々Visual　Basic　Editorを開いてコードをいじらなくてもリストの内容を書き換えられるようにしてあります。

注射薬変更フォーム

リストの内容をまとめて書き表しているエクセルのワークシートです。(下記図参照） 

テンプレートのワークシート（１）

テンプレートのワークシート（２）

 このフォームのコードは以下記載です。 （続きを読むをクリックしてください）


Dim Touseki As Object
Dim iro As Integer
Dim MaxRows As Long
Dim Maxl As Long
Dim ListIdx As Integer
Dim IdxNo As Integer

Private Type MemberData
    Simei1 As String
    Simei4 As String
    Ocyusya(3, 11) As String
    Yobi(3) As String
    iro As Integer
    HenkoSwitch As Boolean
End Type

Dim OldMember() As MemberData
‘Dim HenkoSwitch() As Boolean
Dim ChangeSwitch As Boolean
Dim l As Integer

Private Sub CommandButton2_Click()
    Dim Namae As String
    Dim MeNamae As Object
   
    OptionButton1.Value = False
    OptionButton2.Value = False
    ‘OptionButton3.Value = False
    Namae = TextBox1.Text
    Set MeNamae = Cyusya
    Call 検索(Namae, MeNamae)
End Sub

Private Sub CommandButton3_Click()
    Call 個別へ表示(ByVal l)
End Sub

Private Sub UserForm_Initialize()
    Set Touseki = Worksheets("透析患者リスト")
    Touseki.Activate
    MaxRows = Touseki.UsedRange.Rows.Count
    ListIdx = 0
    ‘ChangeSwitch = False
   
    Call Member
    OptionButton1.Value = True
    注射薬テンプ作成
End Sub

Private Sub Member()
    ReDim OldMember(MaxRows)
    Dim K As Byte
   
    l = 0

    With Touseki
        For i = 3 To MaxRows
           
            With OldMember(l)
                .Simei1 = Touseki.Cells(i, 3)
                .Simei4 = Touseki.Cells(i, 2)
                For K = 0 To 2
                    .Ocyusya(K, 0) = Touseki.Cells(i, 70 + 9 * K)  ‘エルシト
                    .Ocyusya(K, 1) = Touseki.Cells(i, 71 + 9 * K)  ‘キド
                    .Ocyusya(K, 2) = Touseki.Cells(i, 72 + 9 * K)  ‘グリマ
                    .Ocyusya(K, 3) = Touseki.Cells(i, 73 + 9 * K)  ‘ミノ
                    .Ocyusya(K, 4) = Touseki.Cells(i, 74 + 9 * K)  ‘ノイロ
                    .Ocyusya(K, 5) = Touseki.Cells(i, 75 + 9 * K)  ‘アデラ
                    .Ocyusya(K, 6) = Touseki.Cells(i, 76 + 9 * K) ‘エポ
                    .Ocyusya(K, 7) = Touseki.Cells(i, 77 + 9 * K) ‘オキサ
                    .Ocyusya(K, 8) = Touseki.Cells(i, 78 + 9 * K) ‘リクセル
                   
                    .Yobi(K) = Touseki.Cells(i, 33 + K)
                Next
                .HenkoSwitch = False
                .iro = Touseki.Cells(i, 1).Interior.ColorIndex
            End With
            ‘HenkoSwitch(l) = False
               
            l = l + 1
        Next
        Maxl = l
    End With
End Sub

Private Sub ListBox1_Click()
    If ChangeSwitch = True Then
        保存忘れ防止装置
    End If
    ListIdx = ListBox1.ListIndex
    Namae = ListBox1.List(ListIdx)
    l = Kensaku(ByVal Namae)
                  
    Call 個別へ表示(ByVal l)
End Sub
Private Sub Optionbutton1_Change()
    If OptionButton1.Value = True Then
        If ChangeSwitch = True Then
            保存忘れ防止装置
        End If
        ListIdx = 0
        氏名box
    End If
End Sub

Private Sub CxBtn_Click()
    If ChangeSwitch = True Then
        保存忘れ防止装置
    End If
    Rtn = MsgBox("転送せずに終了します。それでよければOKを押してください。", vbOKCancel)
    If Rtn = vbOK Then
        Unload Cyusya
        AboutForm.Show
    End If
End Sub

Private Sub ExitBtn_Click()
    If ChangeSwitch = True Then
        保存忘れ防止装置
    End If
    Rtn = MsgBox("今まで行った変更を、ワークシートへ転送します。よろしければOKを押してください。", vbOKCancel)
    If Rtn = vbOK Then
        変更を保存して終了
       
        Unload Cyusya
        MsgBox ("転送を終了しました。")
        AboutForm.Show
    End If
   
End Sub
Private Sub Optionbutton2_Change()
    If OptionButton2.Value = True Then
        If ChangeSwitch = True Then
            保存忘れ防止装置
        End If
        ListIdx = 0
        氏名box
    End If
End Sub

Private Sub InputBtn_Cli
ck()
    ‘ChangeSwitch = False
    ‘Call 注射変数の更新(ByVal l)
End Sub
Private Sub 氏名box()
    Dim CelNo(3) As String
   
    Set Touseki = Worksheets("透析患者リスト")
    Cyusya.ListBox1.Clear
    ListIdx = 0
   
    If OptionButton1.Value = True Then

        l = 0
        Do ‘赤(月水金AM）の処理
            iro = OldMember(l).iro
            Do While iro = 3
                If OldMember(l).iro <> 3 Then
                    Exit Do
                End If
       
                Cyusya.ListBox1.AddItem (OldMember(l).Simei1)
               
                l = l + 1
           
            Loop
            l = l + 1
        Loop While l < Maxl
       
        l = 0
        Do ‘青(月水金PM）の処理
            iro = OldMember(l).iro
            Do While iro = 5
                If OldMember(l).iro <> 5 Then
                    Exit Do
                End If
       
                Cyusya.ListBox1.AddItem (OldMember(l).Simei1)
               
                l = l + 1
           
            Loop
            l = l + 1
        Loop While l < Maxl
       
        With Cyusya.ListBox1
            .ListIndex = ListIdx
        End With
    End If
   
    If OptionButton2.Value = True Then
        l = 0
        Do ‘黄(火木土AM）の処理
            iro = OldMember(l).iro
            Do While iro = 6
                If OldMember(l).iro <> 6 Then
                    Exit Do
                End If
       
                Cyusya.ListBox1.AddItem (OldMember(l).Simei1)
               
                l = l + 1
           
            Loop
            l = l + 1
        Loop While l < Maxl
       
        l = 0
        Do ‘緑(火木土PM）の処理
            iro = OldMember(l).iro
            Do While iro = 4
                If OldMember(l).iro <> 4 Then
                    Exit Do
                End If
       
                Cyusya.ListBox1.AddItem (OldMember(l).Simei1)
               
                l = l + 1
           
            Loop
            l = l + 1
        Loop While l < Maxl
   
        With Cyusya.ListBox1
            .ListIndex = ListIdx
        End With
       
    End If
End Sub

Sub 個別へ表示(ByVal l As Integer)
   
        Cyusya.ComboBox1.Text = OldMember(l).Ocyusya(0, 0)
        Cyusya.ComboBox4.Text = OldMember(l).Ocyusya(0, 1)
        Cyusya.ComboBox7.Text = OldMember(l).Ocyusya(0, 2)
        Cyusya.ComboBox10.Text = OldMember(l).Ocyusya(0, 3)
        Cyusya.ComboBox13.Text = OldMember(l).Ocyusya(0, 4)
        Cyusya.ComboBox16.Text = OldMember(l).Ocyusya(0, 5)
        Cyusya.ComboBox19.Text = OldMember(l).Ocyusya(0, 6)
        Cyusya.ComboBox22.Text = OldMember(l).Ocyusya(0, 7)
        Cyusya.ComboBox25.Text = OldMember(l).Ocyusya(0, 8)
       
        Cyusya.ComboBox2.Text = OldMember(l).Ocyusya(1, 0)
        Cyusya.ComboBox5.Text = OldMember(l).Ocyusya(1, 1)
        Cyusya.ComboBox8.Text = OldMember(l).Ocyusya(1, 2)
        Cyusya.Combo
Box11.Text = OldMember(l).Ocyusya(1, 3)
        Cyusya.ComboBox14.Text = OldMember(l).Ocyusya(1, 4)
        Cyusya.ComboBox17.Text = OldMember(l).Ocyusya(1, 5)
        Cyusya.ComboBox20.Text = OldMember(l).Ocyusya(1, 6)
        Cyusya.ComboBox23.Text = OldMember(l).Ocyusya(1, 7)
        Cyusya.ComboBox26.Text = OldMember(l).Ocyusya(1, 8)
       
        Cyusya.ComboBox3.Text = OldMember(l).Ocyusya(2, 0)
        Cyusya.ComboBox6.Text = OldMember(l).Ocyusya(2, 1)
        Cyusya.ComboBox9.Text = OldMember(l).Ocyusya(2, 2)
        Cyusya.ComboBox12.Text = OldMember(l).Ocyusya(2, 3)
        Cyusya.ComboBox15.Text = OldMember(l).Ocyusya(2, 4)
        Cyusya.ComboBox18.Text = OldMember(l).Ocyusya(2, 5)
        Cyusya.ComboBox21.Text = OldMember(l).Ocyusya(2, 6)
        Cyusya.ComboBox24.Text = OldMember(l).Ocyusya(2, 7)
        Cyusya.ComboBox27.Text = OldMember(l).Ocyusya(2, 8)
       
    Cyusya.Label43.Caption = OldMember(l).Simei4
   
    Cyusya.Frame1.Caption = OldMember(l).Yobi(0)
    Cyusya.Frame2.Caption = OldMember(l).Yobi(1)
    Cyusya.Frame3.Caption = OldMember(l).Yobi(2)
    ‘Call 曜日更新(ByVal l)
    ChangeSwitch = False
End Sub
Public Function Kensaku(ByVal Namae As String) As Integer

    For l = 0 To Maxl
        If OldMember(l).Simei1 = Namae Then
            Kensaku = l
            Exit For
        End If
    Next
           
End Function

Sub 保存忘れ防止装置()
    ‘Dim Rtn As Byte
   
    ‘Rtn = MsgBox(OldMember(l).Simei4 & "さんの変更を保存しますか？", vbYesNo, "保存確認")
    ‘If Rtn = vbYes Then
    ‘    InputBtn_Click
    ‘End If
    If ChangeSwitch = True Then
        ChangeSwitch = False
        Call 注射変数の更新(ByVal l)
        ‘氏名box
    End If
    ‘ChangeSwitch = False
End Sub
Sub 変更を保存して終了()
    Dim CelNo(3) As String
    Dim i As Integer
    Dim K As Byte
    Dim j As Byte
   
    l = 0
   
    Cyusya.Hide
   
        For i = 3 To MaxRows
            If OldMember(l).HenkoSwitch = True Then
           
                With OldMember(l)
                ‘名前転送
                    Touseki.Cells(i, 3).Activate
                    Touseki.Cells(i, 3) = .Simei1
                   
                ‘注射薬の転送
               
                    For K = 0 To 2
                        For j = 0 To 8
                            Touseki.Cells(i, 70 + j + K * 9).Activate
                            Touseki.Cells(i, 70 + j + K * 9) = .Ocyusya(K, j) ‘エルシト
                        Next
                    Next
                End With
                                 
            End If
            l = l + 1
        Next

End Sub

Sub 注射変数の更新(ByVal l As Integer)
    ‘HenkoSwitch(l) = True
   
    With OldMember(l)
        .HenkoSwitch = True
           
        .Ocyusya(0, 0) = Cyusya.ComboBox1.Text
        .Ocyusya(0, 1) = Cyusya.ComboBox4.Text
        .Ocyusya(0, 2) = Cyusya.ComboBox7.Text
        .Ocyusya(0, 3) = Cyusya.ComboBox10.Text
        .Ocyusya(0, 4) = Cyusya.ComboBox13.Text
        .Ocyusya(0, 5) = Cyusya.ComboBox16.Text
        .Ocyusya(0, 6) = Cyusya.ComboBox19.Text
        .Ocyusya(0, 7) = Cyusya.ComboBox22.Text
        .Ocyusya(0, 8) = Cyusya.ComboBox25.Text
       
        .Ocyusya(1, 0) = Cyusya.ComboBox2.Text
        .Ocyusya(1, 1) = Cyusya.ComboBox5.Text
        .Ocyusya(1, 2) = Cyusya.ComboBox8.Text
        .Ocyusya(1, 3) = Cyusya.ComboBox11.Text
        .Ocyusya(1, 4) = Cyusya.ComboBox14.Text
        .Ocyusya(1, 5) = Cyusya.ComboBox17.Text
        .Ocyusya(1, 6) = Cyusya.ComboBox20.Text
        .Ocyusya(1, 7) = Cyusya.ComboBox23.Text
        .Ocyusya(1, 8) = Cyusya.ComboBox26.
Text
       
        .Ocyusya(2, 0) = Cyusya.ComboBox3.Text
        .Ocyusya(2, 1) = Cyusya.ComboBox6.Text
        .Ocyusya(2, 2) = Cyusya.ComboBox9.Text
        .Ocyusya(2, 3) = Cyusya.ComboBox12.Text
        .Ocyusya(2, 4) = Cyusya.ComboBox15.Text
        .Ocyusya(2, 5) = Cyusya.ComboBox18.Text
        .Ocyusya(2, 6) = Cyusya.ComboBox21.Text
        .Ocyusya(2, 7) = Cyusya.ComboBox24.Text
        .Ocyusya(2, 8) = Cyusya.ComboBox27.Text
    End With
End Sub
       

Sub 注射薬テンプ作成()
    Dim Tate As Integer
    Dim Yoko As Integer
    Dim Tempu As String
    Set Tempulist = Worksheets("テンプレート集")
   
    ‘エルシトニンのテンプレート
    Tate = 3
    Yoko = 26
    Tempu = ""
    Do
        Tempu = Tempulist.Cells(Tate, Yoko)
        ComboBox1.AddItem (Tempu)
        ComboBox2.AddItem (Tempu)
        ComboBox3.AddItem (Tempu)
        Tate = Tate + 1
    Loop While Tempu <> ""
    ‘キドミンのテンプレート
    Tate = 3
    Yoko = 27
    Tempu = ""
    Do
        Tempu = Tempulist.Cells(Tate, Yoko)
        ComboBox4.AddItem (Tempu)
        ComboBox5.AddItem (Tempu)
        ComboBox6.AddItem (Tempu)
        Tate = Tate + 1
    Loop While Tempu <> ""
   
    ‘グリマッケンのテンプレート
    Tate = 3
    Yoko = 28
    Tempu = ""
    Do
        Tempu = Tempulist.Cells(Tate, Yoko)
        ComboBox7.AddItem (Tempu)
        ComboBox8.AddItem (Tempu)
        ComboBox9.AddItem (Tempu)
        Tate = Tate + 1
    Loop While Tempu <> ""
   
    ‘キョウミノのテンプレート
    Tate = 3
    Yoko = 29
    Tempu = ""
    Do
        Tempu = Tempulist.Cells(Tate, Yoko)
        ComboBox10.AddItem (Tempu)
        ComboBox11.AddItem (Tempu)
        ComboBox12.AddItem (Tempu)
        Tate = Tate + 1
    Loop While Tempu <> ""
   
    ‘ノイロのテンプレート
    Tate = 3
    Yoko = 30
    Tempu = ""
    Do
        Tempu = Tempulist.Cells(Tate, Yoko)
        ComboBox13.AddItem (Tempu)
        ComboBox14.AddItem (Tempu)
        ComboBox15.AddItem (Tempu)
        Tate = Tate + 1
    Loop While Tempu <> ""
   
    ‘アデラのテンプレート
    Tate = 3
    Yoko = 31
    Tempu = ""
    Do
        Tempu = Tempulist.Cells(Tate, Yoko)
        ComboBox16.AddItem (Tempu)
        ComboBox17.AddItem (Tempu)
        ComboBox18.AddItem (Tempu)
        Tate = Tate + 1
    Loop While Tempu <> ""
   
    ‘エポのテンプレート
    Tate = 3
    Yoko = 32
    Tempu = ""
    Do
        Tempu = Tempulist.Cells(Tate, Yoko)
        ComboBox19.AddItem (Tempu)
        ComboBox20.AddItem (Tempu)
        ComboBox21.AddItem (Tempu)
        Tate = Tate + 1
    Loop While Tempu <> ""
   
    ‘オキサのテンプレート
    Tate = 3
    Yoko = 33
    Tempu = ""
    Do
        Tempu = Tempulist.Cells(Tate, Yoko)
        ComboBox22.AddItem (Tempu)
        ComboBox23.AddItem (Tempu)
        ComboBox24.AddItem (Tempu)
        Tate = Tate + 1
    Loop While Tempu <> ""
   
    ‘リクセルのテンプレート
    Tate = 3
    Yoko = 34
    Tempu = ""
    Do
        Tempu = Tempulist.Cells(Tate, Yoko)
        ComboBox25.AddItem (Tempu)
        ComboBox26.AddItem (Tempu)
        ComboBox27.AddItem (Tempu)
        Tate = Tate + 1
    Loop While Tempu <> ""
   
End Sub

Private Sub ComboBox1_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox10_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox11_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox12_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox13_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox14_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox15_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox16_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox17_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox18_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox19_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox2_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox20_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox21_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox22_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox23_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox24_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox25_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox26_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox27_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox28_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox29_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox3_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox30_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox31_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox32_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox33_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox4_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox5_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox6_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox7_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox8_Change()
    ChangeSwitch = True
End Sub

Private Sub ComboBox9_Change()
    ChangeSwitch = True
End Sub

コメント

タイトルとURLをコピーしました