HOMEへ

フォーム======================================================

Option Explicit



'**
' フォーム初期化
'------------------------------------------------------------------
Private Sub UserForm_Initialize()

    With Me
        .Caption = "サンプルフォーム"
        .Width = 300
        .Height = 250
    End With

End Sub

'**
' 閉じるボタン
'------------------------------------------------------------------
Private Sub CommandButton1_Click()

    Unload Me

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If MsgBox("本当に閉じてもいいですか？", vbOKCancel) = vbNo Then
        Cancel = 1
    End If

End Sub




Option Explicit

'**
' フォーム初期化
'------------------------------------------------------------------
Private Sub UserForm_Initialize()

    With Me
        .Caption = "サンプルフォーム"
        .Width = 300
        .Height = 250
        .CheckBox1.Value = 1
        .CheckBox4.Value = 1
    End With

End Sub

'**
' 閉じるボタン
'------------------------------------------------------------------
Private Sub CommandButton1_Click()
    Unload Me
End Sub

'**
' チェックボタン
'------------------------------------------------------------------
Private Sub CommandButton2_Click()

    Dim C As Control
    With FormSample2
        For Each C In .Controls
            If TypeName(C) = "CheckBox" Then
                Debug.Print C.Name, C.Value
            End If
        Next C
    
        Dim i As Integer
        For i = 1 To 4
            Set C = .Controls("CheckBox" & i)
            Debug.Print C.Name, C.Value
        Next i
    End With
End Sub




Option Explicit

'**
' フォーム初期化
'------------------------------------------------------------------
Private Sub UserForm_Initialize()

    With Me
        .Caption = "サンプルフォーム"
        .Width = 300
        .Height = 250
    End With

End Sub

'**
' 閉じるボタン
'------------------------------------------------------------------
Private Sub CommandButton1_Click()
    Unload Me
End Sub

'**
' チェックボタン
' textboxがmultiline設定の場合、「vbCrLf」を置換える
'------------------------------------------------------------------
Private Sub CommandButton2_Click()

    With TextBox1
        If InStr(.Value, vbLf) > 0 Then
            .Text = Replace(.Text, vbCrLf, "")
        Else
            Debug.Print .Value
        End If
    End With

End Sub

'**
' フォーカス外れイベント
'------------------------------------------------------------------
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With TextBox2
        If Len(.Value) < 4 Or Not IsNumeric(.Value) Then
            MsgBox "4～8文字の数値を入力してください"
            Cancel = True
        End If
    End With

End Sub




Option Explicit

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub CommandButton2_Click()

End Sub

Private Sub UserForm_Initialize()

    'インデックス番号取得→インデックスより後のシートをコンボボックスに要素追加
    With Me.ComboBox1
        Dim i As Integer

        For i = 1 To Worksheets.Count
            If i > SheetIndexCheck("イメージリスト") Then
                    .AddItem Worksheets(i).Name
            End If
        Next i

    End With

    '配列→コンボボックスリスト
    With Me.ComboBox2
        .List = Array("メニュー1", "メニュー2", "メニュー3", "メニュー4", "メニュー5", "メニュー6", "メニュー7", "メニュー8", "メニュー9", "メニュー10")
    End With

    'クリア
    With Me.ComboBox3
        .List = Array("メニュー1", "メニュー2", "メニュー3", "メニュー4", "メニュー5", "メニュー6", "メニュー7", "メニュー8", "メニュー9", "メニュー10")
        .Clear
    End With


    '日付コンボボックス
    With Me.ComboBox4
        .List = YearArrayCreate()
    End With


    With Me.ComboBox5
        .RowSource = "A2:B13"

    End With

End Sub




Option Explicit

'**
' 閉じるボタン
'------------------------------------------------------------------
Private Sub CommandButton1_Click()
    Unload Me
End Sub

'**
' チェックボタン
' チェックボタン内容の確認
'------------------------------------------------------------------
Private Sub CommandButton2_Click()

    Dim i As Integer
    Dim buf As String
 
    For i = 1 To 9
        If Controls("OptionButton" & i) = True Then
            buf = buf & Controls("OptionButton" & i).Caption & vbCrLf
        End If
    Next i
    '文字列最後からvbCrLf(2文字分)を除いて抽出
    MsgBox Mid(buf, 1, Len(buf) - 2)

End Sub

'**
' チェックボタン
' 配列を使用したチェックボタン内容の確認
'------------------------------------------------------------------
Private Sub CommandButton3_Click()

    Dim arr As Variant: arr = Array("りんご", "みかん", "バナナ", "和食", "洋食", "中華", "晴れ", "曇り", "雨")

    Dim i As Integer
    Dim buf As String

    For i = 1 To 9
        If Controls("OptionButton" & i) = True Then
            buf = buf & arr(i - 1) & vbCrLf
        End If
    Next i
    '文字列最後からvbCrLf(2文字分)を除いて抽出
    MsgBox Mid(buf, 1, Len(buf) - 2)

End Sub

'**
' フォーム初期化
' オプションボタンへの動的にgroupname設定
'------------------------------------------------------------------
Private Sub UserForm_Initialize()

    With Me
        .OptionButton1.Value = True
        .OptionButton4.Value = True
        .OptionButton7.Value = True

'        Dim c As Control
'        Dim cnt As Integer, i As Integer
'        'オプションボタン数チェック
'        For Each c In .Controls
'            If TypeName(c) = "OptionButton" Then
'                cnt = cnt + 1
'            End If
'        Next c
'        'グループ名設定
'        For i = 1 To cnt
'            With .Controls("OptionButton" & i)
'                Select Case i
'                    Case Is < 4
'                        .GroupName = "gp1"
'                    Case Is < 7
'                        .GroupName = "gp2"
'                    Case Else
'                        .GroupName = "gp3"
'                End Select
'            End With
'        Next i
    End With

End Sub




Option Explicit

' **
' ユーザーフォーム初期化
'
Private Sub UserForm_Initialize()
    Call Sheet7.LoadData
    Call LoadIdList
End Sub

' **
' 更新ボタン処理
'
Private Sub CommandButton1_Click()

    If CheckFields Then
        Dim p As Person: Set p = New Person

        p.Name = TextBox1.Text
        p.Birthday = TextBox2.Value
        p.Gender = "女"
        If OptionButton1.Value = True Then p.Gender = "男"
        p.Active = CheckBox1.Value

        If ComboBox1.Value = "New" Then
            p.Id = Sheet7.MaxId + 1
            Call Sheet7.AddPerson(p)
        Else
            p.Id = ComboBox1.Value
            Call Sheet7.UpdatePerson(p)
        End If

        Call LoadFields(p.Id)
        Call LoadIdList

    End If

End Sub

' **
' ユーザーフォーム閉じる
'
Private Sub CommandButton2_Click()
    Unload Me
End Sub

'**
' コンボボックス変更時の処理切り分け
' (Idが選択時、"New"選択時の処理切り分け)
Private Sub ComboBox1_Change()

    With ComboBox1
        If IsValidId Then
            If IsNumeric(.Value) Then
                Call LoadFields(.Value)
            Else
                Call ClearFields
            End If
        End If
    End With

End Sub

' **
' コンボボックスへのテーブルIDリスト読み込み
'
Private Sub LoadIdList()

    With Sheet7.ListObjects(1)
        If .ListRows.Count > 1 Then
            Dim lists As Variant: lists = .ListColumns(1).DataBodyRange
            ComboBox1.List = lists
        End If
    End With

    ComboBox1.AddItem "New"

End Sub

' **
' コンボボックスのId値が正しいかどうか
' (Idが1以上かつ最大値以下または"New"かどうか)
' @return {boolean}
Private Property Get IsValidId() As Boolean

    IsValidId = False
    With ComboBox1
        If (.Value > 0 And .Value <= Sheet7.MaxId) Or (.Value = "New") Then
            IsValidId = True
        End If
    End With

End Property

' **
' 指定Idでのレコードデータの呼び出し
' @param {myId：Long} 呼び出すレコードデータのId値
Private Sub LoadFields(ByVal myId As Long)

    With Sheet7.Persons(myId)
        ComboBox1.Value = myId
        TextBox1.Value = .Name
        TextBox2.Value = .Birthday
        Call SetGender(.Gender)
        CheckBox1.Value = .Active
        Label5.Caption = .Age
    End With

End Sub

' **
' 性別文字列(男、女)をもとにオプションボタンを設定
' @param {myGender：String} 性別文字列
Private Sub SetGender(ByVal myGender As String)

    OptionButton2.Value = True
    If myGender = "男" Then OptionButton1.Value = True

End Sub

' **
' 各コントロールの値をクリア
'
Private Sub ClearFields()

    TextBox1.Value = ""
    TextBox2.Value = ""
    OptionButton1.Value = True
    CheckBox1.Value = True
    Label5.Caption = ""

End Sub

' **
' 各コントロール値が正しく入力されているかどうかを判定する
'
' @return {Boolean}
'
Private Function CheckFields() As Boolean

    CheckFields = True

    If Not IsValidId Then
        MsgBox "「ID」は1以上IDの最大値以下の数値または""New""を入力してください", vbInformation
        CheckFields = False
    End If

    If Len(TextBox1.Text) = 0 Then
        MsgBox "「名前」に入力してください", vbInformation
        CheckFields = False
    End If

    If IsDate(TextBox2.Value) Then
        MsgBox "「誕生日」には日付を入力してください", vbInformation
        CheckFields = False
    End If

End Function




Option Explicit

'**
' 更新ボタン
' CommandButton1_Click
Private Sub CommandButton1_Click()

    Dim Flg As Integer: Flg = 0
    Dim i As Integer

'    For i = 1 To 2
'        MsgBox MdCheckCombox(Me("ComboBox" & i))
'    Next i


Debug.Print MdCheckComboxs(Me)


'    For i = 1 To 5
'        flg = flg + MdCheckText(Me("TextBox" & i))
'    Next i

'    If MdCheckTexts(Me) = True Then
'        MsgBox "未入力箇所があります"
'    End If

End Sub

'**
' キャンセルボタン
' CommandButton2_Click
Private Sub CommandButton2_Click()
    
    Unload Me

End Sub

'**
' テキストボックス空欄チェック : 単数
'  @param {tBox : MSForms.TextBox} テキストボックス
'  @return {FmCheckText : Boolean}
Function FmCheckText(tBox As MSForms.TextBox) As Boolean

    With tBox
        If .Value = "" Or IsNull(.Value) Then
            .BackColor = RGB(245, 200, 238)
             FmCheckText = True
             Exit Function
        End If
    End With

    FmCheckText = False

End Function

'**
' テキストボックス空欄チェック : 複数
'  @return {FmCheckTexts : boolean}
Function FmCheckTexts() As Boolean

    Dim Flg As Integer: Flg = 0
    Dim myControl As Control
    
    For Each myControl In Controls
        If TypeName(myControl) = "TextBox" Then
            If myControl.Value = "" Or IsNull(myControl.Value) Then
                myControl.BackColor = RGB(245, 200, 238)
                Flg = Flg + 1
            End If
        End If
    Next myControl

    If Flg > 0 Then
        CheckText = True
    Else
        CheckText = False
    End If

End Function

'**
' コンボボックス空欄チェック : 単数
'  @param {cBox : MSForms.ComboBox} コンボボックス
'  @return {FmCheckCombox : Boolean}
Function FmCheckCombox(cBox As MSForms.ComboBox) As Boolean

    With cBox
        If .Value = "" Or IsNull(.Value) Then
            .BackColor = RGB(245, 200, 238)
             FmCheckCombox = True
             Exit Function
        End If
    End With

    FmCheckCombox = False

End Function

'**
' コンボボックス空欄チェック : 複数
'  @return {FmCheckComboxs : boolean}
Function FmCheckComboxs() As Boolean

    Dim Flg As Integer: Flg = 0
    Dim myControl As Control
    
    For Each myControl In Controls
        If TypeName(myControl) = "ComboBox" Then
            If myControl.Value = "" Or IsNull(myControl.Value) Then
                myControl.BackColor = RGB(245, 200, 238)
                Flg = Flg + 1
            End If
        End If
    Next myControl

    If Flg > 0 Then
        FmCheckComboxs = True
    Else
        FmCheckComboxs = False
    End If

End Function