TOTO予想ソフトを作ってみよう　「変更されています。」の追加

TOTO予想ソフトを作ってみよう

Step 9 「変更されています。」の追加

シートコード

下記のコードを追加してください
'データ変更がある場合はメッセージを表示
Private Function DataChangeMsg() As Boolean
    Dim ans As Integer

    DataChangeMsg = True
    If bDataChangeFlag Then
        Beep
        ans = MsgBox("データが変更されています。消去されますがよろしいですか？", vbOKCancel, "TOTO予想Excel")
        If ans = vbCancel Then
            DataChangeMsg = False
        End If
    End If
End Function

'変更は入力セル位置かチェック
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range(Target.Address), Range("F5:F17")) Is Nothing Then
        bDataChangeFlag = True
        Exit Sub
    End If
    If Not Intersect(Range(Target.Address), Range("H5:J17")) Is Nothing Then
        bDataChangeFlag = True
        Exit Sub
    End If
    If Target.Address = "$F$2" Then
        bDataChangeFlag = True
        Exit Sub
    End If
    If Target.Address = "$H$2" Then
        bDataChangeFlag = True
    End If
End Sub

下記のコードを変更してください。
'T戦績から戦績入力へコピー
Private Sub DataDisp(srow As String)
    Dim i As Integer
    Dim scell1 As String
    Dim scell2 As String

    '回数
    Range("F2") = Sheets("T戦績").Range(srow)
    '前、次ボタン用のセル位置
    Sheets("T戦績").Range("CR8") = "<=" & Range("F2")
    Sheets("T戦績").Range("CR9") = ">=" & Range("F2")
    '日付
    Range("H2") = Sheets("T戦績").Range(srow).Offset(0, 1)

    Range("F5").Select
    'T戦績コピー開始位置
    scell1 = A1Add(srow, 0, 2)
    scell2 = A1Add(scell1, 0, 2) & ":" & A1Add(scell1, 0, 4)
    For i = 0 To 12
        'コピー
        Sheets("T戦績").Range(scell1).Copy Destination:=Range("F5").Offset(i, 0)
        Sheets("T戦績").Range(scell2).Copy Destination:=Range("H5").Offset(i, 0)

        scell1 = A1Add(scell1, 0, 7)
        scell2 = A1Add(scell1, 0, 2) & ":" & A1Add(scell1, 0, 4)
    Next
    bDataChangeFlag = False
End Sub

Private Sub InputClear()
    Range("F2") = ""
    Range("H2") = ""
    Range("F5:F17") = ""
    Range("H5:J17") = ""
    bDataChangeFlag = False
End Sub

'クリアボタン
Private Sub CommandButton2_Click()
    If DataChangeMsg = False Then
        Exit Sub
    End If
    InputClear
End Sub

'先頭レコード
Private Sub CommandButton3_Click()
    Dim sr As String

    If FindMin(sr) Then
        If DataChangeMsg = False Then
            Exit Sub
        End If

        DataDisp sr
    Else
        Beep
    End If
End Sub

'前のレコード
Private Sub CommandButton4_Click()
    Dim sr As String

    If Range("F2") = "" Then
        CommandButton6_Click
    Else
        If IsNumeric(Sheets("T戦績").Range("CT9")) Then
            If DataChangeMsg = False Then
                Exit Sub
            End If

            CopyToSheetCheck Sheets("T戦績").Range("CT9"), sr
            DataDisp sr
        Else
            Beep
        End If
    End If
End Sub

'次のレコード
Private Sub CommandButton5_Click()
    Dim sr As String

    If Range("F2") = "" Then
        CommandButton3_Click
    Else
        If IsNumeric(Sheets("T戦績").Range("CT8")) Then
            If DataChangeMsg = False Then
                Exit Sub
            End If

            CopyToSheetCheck Sheets("T戦績").Range("CT8"), sr
            DataDisp sr
        Else
            Beep
        End If
    End If
End Sub

'最終レコード
Private Sub CommandButton6_Click()
    Dim sr As String

    If FindMax(sr) Then
        If DataChangeMsg = False Then
            Exit Sub
        End If

        DataDisp sr
    Else
        Beep
    End If
End Sub

'検索ボタン
Private Sub CommandButton7_Click()
    Dim s As String
    Dim srow As String
    Dim lk As Long
    Dim tRange As Range

    If DataChangeMsg = False Then
        Exit Sub
    End If

    s = TextBox1
    If IsNumeric(s) = False Then
        Beep
        MsgBox "回数を入力してください。", , "TOTO予想Excel"
        TextBox1.Activate
        Exit Sub
    End If

    lk = TextBox1

    '1行目から検索
    Set tRange = Sheets("T戦績").Columns(1)
    Set tRange = tRange.Find(What:=lk, LookIn:=xlValues, LookAt:=xlWhole)
    If Not tRange Is Nothing Then
        srow = tRange.Address(RowAbsolute:=False, ColumnAbsolute:=False)
        DataDisp srow
    End If
End Sub

標準モジュールコード

下記のコードを追加してください
Option Explicit Public bDataChangeFlag As Boolean

ワークブックコード

下記のコードを追加してください
Private Sub Workbook_Open()
bDataChangeFlag = False
End Sub

戦績入力画面

	データ変更がある場合、メッセージが表示されます。

Topへ