' [432.xls]



' [Module1] のコード
'★★☆　スクロールバーを使って日付を操作する　☆★★

Option Explicit

Sub start()

    UserForm1.Show

End Sub


' [UserForm1] のコード
Option Explicit

Dim tuki As Integer
Dim hi As Integer
Dim flg As Boolean

Private Sub ScrollBar1_Change()

    With ScrollBar1
        'ScrollBar2の Changeイベント発生から値を保護する為にフラグを立てる
        flg = False
    
        '年度表示
        Label1.Caption = .Value
        Label2.Caption = Format(ScrollBar2.Value, "ggge年")
    
        'ScrollBar1の値(年度)に見合う ScrollBar2の最大、最小値を合わせる(年度に対する日数)
        ScrollBar2.Max = DateSerial(.Value, 12, 31)
        ScrollBar2.Min = DateSerial(.Value, 1, 1)
    
        'ScrollBar2の Changeイベント の発生を戻す
        flg = True
    
        ScrollBar2.Value = DateSerial(.Value, tuki, hi)
    
    End With

End Sub

Private Sub ScrollBar1_Scroll()
    
    ScrollBar1_Change

End Sub

Private Sub ScrollBar2_Change()

    With ScrollBar2
    
        'フラグを判断して ScrollBar2の値が変更されるのを制限する
        If flg = False Then Exit Sub

        Label3.Caption = Format(.Value, "yyyy年mm月dd日")
        tuki = Val(Format(.Value, "m"))
        hi = Val(Format(.Value, "d"))
        Label4.Caption = Format(.Value, "aaaa")
    
    End With

End Sub

Private Sub ScrollBar2_Scroll()

    ScrollBar2_Change

End Sub

Private Sub UserForm_Initialize()

    '全ての設定を開始するまで、イベントによるエラーを防ぐためにフラグを立てる
    flg = False
    
    tuki = Val(Format(Date, "m"))
    hi = Val(Format(Date, "d"))
    
    With ScrollBar1
        'ScrollBar1に許容年度範囲を設定する、ここでは1870年〜2100にセットする
        .Max = 2100
        .Min = 1870
        
        'ScrollBar1に今日の日付の年度を設定
        .Value = Val(Format(Date, "yyyy"))
    End With
    
    With ScrollBar2
    
        'ScrollBar2 に年間の許容日付範囲を設定する
        .Max = DateSerial(ScrollBar1.Value, 12, 31)
        .Min = DateSerial(ScrollBar1.Value, 1, 1)
    
        'ScrollBar2に今日の日付を保持させる
        .Value = DateSerial(ScrollBar1.Value, tuki, hi)
    
        '年度を和暦に変換、表示
        Label2.Caption = Format(.Value, "ggge年")
    
    End With
    
    '全ての設定が終了したこの時点からイベントによる値の変更を許可する
    flg = True
    
End Sub