サンプルマクロは、インプットボックスに入力された生年月日から
簡易履歴を作成し、新規シートに出力します。
Sub Sample()
Dim myTitle As Variant
Dim strBirth As String, dateBirth As Date
Dim myDate As Date
myTitle = Array("小学校卒業", "中学校卒業" _
, "高校入学", "高校卒業", "大学入学" _
, "大学卒業", "(短大卒業)")
On Error Resume Next
Do
strBirth = InputBox("誕生日を入力してください。")
If strBirth = vbNullString Then Exit Sub
Err.Clear
dateBirth = CDate(strBirth)
Loop Until Err.Number = 0
On Error GoTo 0
myDate = dateBirth
Do Until Month(myDate) = 4 And Day(myDate) = 1
myDate = DateAdd("d", 1, myDate)
Loop
Application.ScreenUpdating = False
Sheets.Add , Sheets(Sheets.Count)
Range("A1:G1").Value = myTitle
Columns("A:G").AutoFit
With Range("A2")
.Value = Year(myDate) + 12 & "/3"
.Offset(, 1).Value = Year(myDate) + 15 & "/3"
.Offset(, 2).Value = Year(myDate) + 15 & "/4"
.Offset(, 3).Value = Year(myDate) + 18 & "/3"
.Offset(, 4).Value = Year(myDate) + 18 & "/4"
.Offset(, 5).Value = Year(myDate) + 22 & "/3"
.Offset(, 6).Value = Year(myDate) + 20 & "/3"
End With
Application.ScreenUpdating = True
End Sub
|