Excelで生産予定・実績表を作ってみよう

Option Explicit

Private MakeSheetName As String

'シートの存在チェック
Private Function ExSheetexist(sheetname As String) As Boolean
  Dim tsheet As Object
  
  ExSheetexist = False
  '全シートを順に調べる
  For Each tsheet In ActiveWorkbook.Worksheets
    If LCase(tsheet.Name) = LCase(sheetname) Then
        '同じ名前が見つかれば終了
        ExSheetexist = True
        Exit For
    End If
  Next
End Function

'新しいシート名を捜す
Private Function ExNewSheetName() As String
    Dim n As Long
    Dim sheetname As String
    
    '「年月」をシート名にする
    sheetname = Range("L9") & "年" & Range("L10") & "月"
    If ExSheetexist(sheetname) Then
        '同名シートが見つかった場合
        n = 1
        Do
            '連番を加えてシート名にする
            If ExSheetexist(sheetname & "(" & n & ")") = False Then
                'このシート名はない
                ExNewSheetName = sheetname & "(" & n & ")"
                Exit Do
            End If
            '次のシート名
            n = n + 1
        Loop
    Else
        ExNewSheetName = sheetname
    End If
End Function

'設定値のチェック
Private Function SetDataCheck() As Boolean
    SetDataCheck = False
    
    '開始セル位置
    If Range("L4") = "" Then
        Range("L4").Select
        Beep
        MsgBox "開始セル位置を入力してください。", , "生産予定実績表"
        Exit Function
    End If
    
    '作成年のチェック
    If Range("L9") < 2000 Or Range("L9") > 2100 Then
        Range("L9").Select
        Beep
        MsgBox "作成年を2000～2100の範囲で入力してください。", , "生産予定実績表"
        Exit Function
    End If
    
    '作成月のチェック
    If Range("L10") < 1 Or Range("L10") > 12 Then
        Range("L10").Select
        Beep
        MsgBox "作成月を1～12の範囲で入力してください。", , "生産予定実績表"
        Exit Function
    End If
    
    SetDataCheck = True
End Function

Private Sub ExNewSheetMake()
    MakeSheetName = ExNewSheetName
    'シートの追加
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    '名前の変更
    ActiveWorkbook.ActiveSheet.Name = MakeSheetName
End Sub

Private Sub CommandButton1_Click()
    Range("L12").Select
    If Not SetDataCheck Then
        Exit Sub
    End If
        
    ExNewSheetMake
    
    Worksheets("機種マスター").Select
    Range("L12").Select

End Sub