'*********************************************************
'用途: 与えられた身長と体重からBMIを求め、表示する。
'受け取る値: dblHeight: 身長(m単位)(Double)
' dblWeight: 体重(kg単位)(Double)
'戻り値: なし
'*********************************************************
Sub ShowBMI(dblHeight, dblWeight)
'引数のチェック
If Not(TypeName(dblHeight) = "Double" And _
TypeName(dblWeight) = "Double") Or _
dblHeight = 0 Then
MsgBox "引数が正しくありません"
Exit Sub 'Subプロシージャを抜ける
End If
Dim strMessage
'BMIから肥満度を判定する
If dblBMI >= 25 Then
strMessage = "あなたは、肥満です。"
ElseIf dblBMI <= 18 Then
strMessage = "あなたは、やせです。"
Else
strMessage = "あなたは、標準です。"
End If
MsgBox strMessage & vbCrLf & _
"身長=" & dblHeight & "m、体重=" & dblWeight & "kg、BMI=" & dblBMI
End Sub
'週ごとに回されるカウンタ
For intCounterWeek = 1 To 6
'日〜土回されるカウンタ
For intCounterDay = 1 To 7
'もし、最初の週でオフセットより先の日、
'もしくはほかの週の場合、
'かつintTempDayが最後の日まで行ってなければ
If ((intCounterWeek = 1 And _
intOffset <= intCounterDay) Or _
intCounterWeek > 1) And _
intTempDay <= intLastDay Then
'カウンタの日とタブを変数に代入
strCalendar = strCalendar & intTempDay & vbTab
'カウンタを1つ増やす(インクリメントする)
intTempDay = intTempDay + 1
'そうでない場合は
Else
'タブだけを代入する
strCalendar = strCalendar & vbTab
End If
If intCounterDay = 7 Then
'週の最後は、文字列の最後のTabが余計なので削る
strCalendar = Left(strCalendar, Len(strCalendar) - 1)
End If
Next
'週ごとに改行コードを入れる
strCalendar = strCalendar & vbCrLf & vbCrLf
Next