HOMEへ

コントロール======================================================

Option Explicit

' **
' ユーザーフォーム表示
'
Sub ShowUserForm()
    
    UserForm1.Show vbModeless

End Sub

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

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

    MdCheckText = False

End Function

'**
' テキストボックス空欄チェック 一括
'  @param {myForm : Object} フォーム(Me)
'  @return {MdCheckTexts : boolean}
Function MdCheckTexts(myForm As Object) As Boolean

    With myForm
        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
    End With

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

End Function

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

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

    MdCheckCombox = False

End Function

'**
' コンボボックス空欄チェック : 複数
'  @param {myForm : Object} フォーム(Me)
'  @return {MdCheckComboxs : boolean}
Function MdCheckComboxs(myForm As Object) As Boolean

    With myForm
        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
    End With

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

End Function

'**
' テキストボックスハイフン削除
'  @param {tBox : TextBox} テキストボックス
'------------------------------------------------------------------
Public Sub HyphenDelete(tBox As TextBox)

    If Not IsNull(tBox.Value) Or tBox.Value = "" Then
        With tBox
            .Value = Replace(.Value, "ー", "")
            .Value = Replace(.Value, "-", "")
            .Value = Replace(.Value, "－", "")
        End With
    End If

End Sub

'**
' テキストボックススペース削除
'  @param {tBox : TextBox} テキストボックス
'------------------------------------------------------------------
Public Sub SpaceDelete(tBox As TextBox)

    If Not IsNull(tBox.Value) Or tBox.Value = "" Then
        With tBox
            .Value = Replace(.Value, "　", "")
            .Value = Replace(.Value, " ", "")
        End With
    End If

End Sub

Sub file_select_update()
'--------------------------------------------------------------------------
'  設定ファイルコンボボックス
'  初期化 リスト作成
'--------------------------------------------------------------------------
Dim arrayName, arrayNames As Variant
Dim act, ws As Worksheet
Dim Flg, i As Integer

Set act = ActiveSheet
If act.Name = "設定" Then

    act.OLEObjects("ComboBox1").Object.Clear
    act.OLEObjects("ComboBox2").Object.Clear
    arrayNames = Array("ComboBox1", "ComboBox2")

'elseif ws.Name = "〇〇" Then

'    ComboBox3.Clear
'    ComboBox4.Clear
'    ComboBox5.Clear
'    arrayNames = Array("ComboBox3", "ComboBox4",  "ComboBox5")

End If
'Worksheets("設定").ComboBox2.List = Array("売上", "売上原価", "経費", "引当金等の繰戻・繰入", "資産", "負債", "資本に関する勘定科目")
For Each arrayName In arrayNames
    'コンボボックス動的変更
    With act.OLEObjects(arrayName).Object
        Flg = 0
        For Each ws In Worksheets
            If ws.Name = "BaseST" Then
                Flg = 1
            Else
                'BaseSTファイルを通過
                If Flg = 1 Then
                    .AddItem ws.Name
                End If
            End If
        Next
    End With
Next

End Sub