[ ユーザーフォーム_目次 ]

照会・削除用フォーム

削除用フォームは、表示されている会員を削除します。削除は、ワークシートから消去するのではなく、削除年月日を入力することで削除ステータスに変更する、というイメージです。

[ 目次 ]
  1. 画面を再確認
  2. 表示位置の工夫：ラベルの２枚重ね
  3. 初期処理
  4. 削除ボタン　クリック時
  5. 閉じるボタン　クリック時



画面を再確認

照会時
照会1

削除時
削除1



表示位置の工夫：ラベルの２枚重ね

このフォームで値を変更することはないので、データをラベルで表示しています。
テキストボックスのスタイルを変えればよいかと思っていたのですが、入力不可にすると、文字列の色が薄くなってしまう問題に直面しました。

そこでラベルの使用になったのですが、ラベルは文字列が上寄りになり、縦位置のセンタリングができない欠点があります。 この問題を回避すべく、ラベルを２枚重ねして、縦位置でセンタリングされているように見える細工をしました。具体的には以下です。

  1. まず、下地となるラベルを配置する。背景色(今回は白)を指定し、必ず「書式 →順序」で「最背面に移動」の指定をする。
  2. 次に、データを表示するラベルをその上に配置する。背景色(プロパティの BackColor )は 0 - fmBackStyleTransparent (透過)を指定する。
  3. 位置の微調整は、 Top/Left/Hight/Width などのプロパティを変更して行う。

これにより、サンプル画面で確認できる程度には調整できました。
表示の順序指定がうまくいかず、文字列が表示されない場合があります。
そんな時は、文字列用ラベルの「最前面に移動」や、背景用ラベルの「最背面に移動」をして調整しました。
それでもダメなときは、２枚のラベルを離してから再度重ねるなどしてください。

テキストボックスの入力不可ではやや不満、という時には、こんな方法もどうでしょうか。



初期処理

  1. 表示内容をセットします。
  2. 選択された処理(照会/削除)に応じて、ラベルやボタンの表示/非表示や表示名を切り替えています。 

Private Sub UserForm_Initialize()
    
    '表示項目の値をセット
    With FormSearch.ListMembers
        LabelID.Caption = .List(.ListIndex, 0)
        LabelName.Caption = .List(.ListIndex, 1)
        LabelSex.Caption = .List(.ListIndex, 2)
        LabelDateOfBirth.Caption = .List(.ListIndex, 3)
        LabelDelDate.Caption = .List(.ListIndex, 4)
    End With
    
    '選択されている処理に従って表示内容を切り替え
    Select Case Mode
        Case Mode_Del
            FormRef_Del.Caption = "会員削除"
            ButtonClose.Caption = "キャンセル"
            ButtonDel.Visible = True
            LabelDelDate.Visible = False
            LabelDelDateHeader.Visible = False
            LabelDelDateBack.Visible = False
        Case Else
            FormRef_Del.Caption = "会員照会"
            ButtonClose.Caption = "閉じる"
            ButtonDel.Visible = False
    End Select
        
End Sub



削除ボタン　クリック時

表示されている会員データを削除します。 

Private Sub ButtonDel_Click()

    If MsgBox(LabelID.Caption & vbCrLf & LabelName.Caption & vbCrLf & "この会員を削除しますか？" _
                , vbExclamation + vbOKCancel, "確認") = vbOK Then
        If MemberIsDeleted(LabelID.Caption) Then
            MsgBox LabelID.Caption & vbCrLf & LabelName.Caption & vbCrLf & "この会員を削除しました。" _
            , vbInformation + vbOKOnly, "確認"
            '検索画面のリストボックスを更新
            FilterMembers
            FormSearch.UpdateListMembers
        Else
            MsgBox LabelID.Caption & vbCrLf & LabelName.Caption & vbCrLf & "この会員の削除を中止しました。" _
            , vbCritical + vbOKOnly, "確認"
        End If
    Else
        MsgBox "キャンセルしました。", vbInformation + vbOKOnly, "確認"
    End If
    
    Unload Me
    
End Sub

----------------------------------------------------------------------
Private Function MemberIsDeleted(ByVal inputID As String) As Boolean

    Worksheets("Sheet1").Select
        
    Dim lastRow As Integer
    lastRow = Range("A1048576").End(xlUp).Row
    
    Dim i As Integer
    i = 2
    
    Do While i <= lastRow
        If Cells(i, 1).Value = inputID Then
            Cells(i, 5).Value = Date
            MemberIsDeleted = True
            Exit Function
        End If
        i = i + 1
    Loop
    
    MemberIsDeleted = False

End Function
− Memo −
  1. １プロシージャにすべて記述すると長いので、ID をキーにした削除処理を分割しました。
  2. 削除は、物理的にデータを削除するのではなく、「削除年月日」項目に当日をセットするようにしています。
  3. 削除処理の戻り値をブーリアンにしているのは、何かしら不具合が生じた場合への、念のための備えです。
  4. 削除後、削除完了のメッセージボックスを出して、フォームを閉じます。
  5. フォームを閉じたとき、検索用フォームのリストボックスの値が変更前のままだと違和感がありました。 なので、同じ条件で再検索をして、リストボックスの値を再設定しています。



閉じるボタン　クリック時

登録用フォームを閉じます。 

Private Sub ButtonClose_Click()

    Unload Me

End Sub