スケジュール管理表を作成 ⑦ 案件追加用フォーム作成

先日から、スケジュール管理表をExcelで作成している。
infoment.hatenablog.com
今日も、前回の続きから。
f:id:Infoment:20210118230027p:plain

例えば、実施内容のＣとＤの間に、新たな案件を追加したいとする。
f:id:Infoment:20210118230218p:plain

現状は、行を挿入したうえで実施内容と作業予定時間の入力を、それぞれ
手入力で行う必要がある。
f:id:Infoment:20210118230357p:plain

ここで少しでも手間を減らしたいので、案件追加用フォームを作成する
ことにした。

まず、フォームの起動はNo列（＝Ａ列）を選択した際に行うとしよう。
↓ シートモジュール。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Tb.ListRows.Count = 0 Then Exit Sub
    If Intersect(Target, Tb.ListColumns(列名.enNo).DataBodyRange) Is Nothing Then Exit Sub
    
    uf案件追加.Show
End Sub

次いで、ユーザーフォーム（上記の「uf案件追加」）を準備する。
f:id:Infoment:20210118230747p:plain

なお、ユーザーフォーム上の各オブジェクト名は下記のとおり。

tb実施内容　　：実施内容入力用テキストボックス
tb作業予定時間：作業予定時間入力用テキストボックス
sb時間増減　　：15分単位で入力時間を増減するスピンボタン
ob上に追加　　：選択セルの上の行に案件追加
ob下に追加　　：選択セルの下の行に案件追加
cb入力　　　　：案件入力ボタン
cb終了　　　　：このフォームを閉じるボタン

まず、以下のプロパティを準備。
※以降、全てユーザーフォームモジュールに記載。

① 入力ボタンを押して良いかどうかのフラグ。
　入力条件がそろって初めて、Trueになる。

Private Property Get fg入力() As Boolean
    Dim fg実施内容 As Boolean
    Dim fg作業予定時間 As Boolean
        If tb実施内容 <> vbNullString Then fg実施内容 = True
        If tb作業予定時間 <> vbNullString Then fg作業予定時間 = True
        
        fg入力 = fg実施内容 * fg作業予定時間
End Property

② 時分秒を、数値にする。
　例えば１時間半「1:30」を、「1.5」にする。

Private Property Get 数値時間() As Double
    Dim myReg As Object
    Set myReg = CreateObject("VBScript.RegExp")
        myReg.Pattern = "^(\d{1,2}):(\d{1,2})$"
    Dim MC As Object
    Dim SM As Object
        
        If myReg.test(tb作業予定時間) Then
            Set MC = myReg.Execute(tb作業予定時間)
            Set SM = MC(0).SubMatches
            数値時間 = SM(0) + SM(1) / 60
        Else
            数値時間 = 1
        End If
End Property

③ 案件を追加する行番号を取得する。

Private Property Get TargetRowIndex() As Long
    TargetRowIndex = Selection.row - Tb.Range(1).row
    If ob下に追加 Then
        TargetRowIndex = TargetRowIndex + 1
    End If
End Property

④ 案件追加対象であるテーブル（＝スケジュール管理表）。

Private Property Get Tb() As ListObject
    Set Tb = ActiveSheet.ListObjects(1)
End Property

以上を踏まえたうえで、起動時の初期化を行う。
※個人的に、最も頻度が高いと思う値を設定している。
※スピンボタンが０～８なのは、１日８時間労働の場合を想定。
※最初は入力ボタンを無効化しておく（実施内容未記載なので）。

Private Sub UserForm_Initialize()
    tb実施内容.SetFocus
    tb作業予定時間 = "0:30"
    ob下に追加 = True
    sb時間増減.Min = 0
    sb時間増減.Max = 8
    cb入力.Enabled = fg入力
End Sub

実施内容の入力状況と、入力ボタンを押せるか否かを連動させる。

Private Sub tb実施内容_Change()
    cb入力.Enabled = fg入力
End Sub

スピンボタンの増減で、15分（＝0.25時間）単位で作業予定時間を増減させる。

Private Function wf() As WorksheetFunction
    Set wf = WorksheetFunction
End Function

Private Sub sb時間増減_SpinUp()
    Dim temp As Double
        temp = 数値時間
        If temp <> sb時間増減.Min Then
            temp = wf.MRound(temp - 0.25, "0.25")
            tb作業予定時間 = wf.RoundDown(temp, 0) & ":" & _
                             Format((temp - wf.RoundDown(temp, 0)) * 60, "00")
        End If
End Sub

Private Sub sb時間増減_SpinDown()
    Dim temp As Double
        temp = 数値時間
        If temp <> sb時間増減.Max Then
            temp = wf.MRound(temp + 0.25, "0.25")
            tb作業予定時間 = wf.RoundDown(temp, 0) & ":" & _
                             Format((temp - wf.RoundDown(temp, 0)) * 60, "00")
        End If
End Sub

入力ボタンと終了ボタン。

Private Sub cb入力_Click()
    With Tb.ListRows.Add(TargetRowIndex)
        .Range(en実施内容) = tb実施内容
        .Range(en作業予定時間) = tb作業予定時間
    End With
    Unload Me
End Sub

Private Sub cb終了_Click()
    Unload Me
End Sub