‘-------------------うるう年かどうかを調べる関数-----------------

Public Function Uruudoshi(y As Integer) As Integer

Dim u As Integer

If (y Mod 4) <> 0 Then

u = 0

ElseIf (y Mod 100) <> 0 Then

u = 1

ElseIf (y Mod 400) <> 0 Then

u = 0

Else

u = 1

End If

Uruudoshi = u

End Function

‘----------------------------その日がその年の何日めかを調べる関数------------------------------

Public Function Nannichime(y As Integer, m As Integer, d As Integer) As Integer

Dim dd As Integer

Dim mdays As Integer

Dim u As Integer

u = Uruudoshi(y)

Select Case m

Case 1

mdays = 0

Case 2

mdays = 31

Case 3

mdays = 31 + (28 + u)

Case 4

mdays = 31 + (28 + u) + 31

Case 5

mdays = 31 + (28 + u) + 31 + 30

Case 6

mdays = 31 + (28 + u) + 31 + 30 + 31

Case 7

mdays = 31 + (28 + u) + 31 + 30 + 31 + 30

Case 8

mdays = 31 + (28 + u) + 31 + 30 + 31 + 30 + 31

Case 9

mdays = 31 + (28 + u) + 31 + 30 + 31 + 30 + 31 + 31

Case 10

mdays = 31 + (28 + u) + 31 + 30 + 31 + 30 + 31 + 31 + 30

Case 11

mdays = 31 + (28 + u) + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31

Case 12

mdays = 31 + (28 + u) + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30

End Select

dd = mdays + d

Nannichime = dd

End Function

‘--------------ソフト本体----------------

Private Sub Command1_Click()

Dim Birthday As YMDday

Dim Today As YMDday

Dim Xyear As Integer

Dim Days As Long

Dim mdays As Integer

Dim Bdays As Integer

Dim Tdays As Integer

If Val(Text1.Text) > Year(Now) Then

Label14.Caption = "入力エラー"

ElseIf Val(Text2.Text) > 12 Then

Label14.Caption = "入力エラー"

ElseIf Val(Text3.Text) > 31 Then

Label14.Caption = "入力エラー"

Else

Label14.Caption = ""

End If

Birthday.Year = Val(Text1.Text)

Birthday.Month = Val(Text2.Text)

Birthday.Day = Val(Text3.Text)

Today.Year = Year(Now)

Today.Month = Month(Now)

Today.Day = Day(Now)

Text4.Text = Today.Year

Text5.Text = Today.Month

Text6.Text = Today.Day

Bdays = Nannichime(Birthday.Year, Birthday.Month, Birthday.Day)

Tdays = Nannichime(Today.Year, Today.Month, Today.Day)

If Birthday.Year = Today.Year Then

Days = Tdays - Bdays + 1

Else

Days = (365 + Uruudoshi(Birthday.Year)) - Bdays + 1

Xyear = Birthday.Year + 1

While Xyear < Today.Year

Days = Days + 365 + Uruudoshi(Xyear)

Xyear = Xyear + 1

Wend

If Xyear = Today.Year Then

Days = Days + Tdays

End If

End If

Text7.Text = Days

If Birthday.Year > Today.Year Then

Text7.Text = "Error"

ElseIf Birthday.Year = Today.Year Then

If Birthday.Month > Today.Month Then

Text7.Text = "Error"

ElseIf Birthday.Month = Today.Month Then

If Birthday.Day > Today.Day Then

Text7.Text = "Error"

End If

End If

End If

End Sub

‘------------ソフトを終了させる---------

Private Sub Command2_Click()

End

End Sub

‘--------------入力を消去する-----------

Private Sub Command3_Click()

Text1.Text = " "

Text2.Text = " "

Text3.Text = " "

Text7.Text = " "

Label14.Caption = " "

End Sub