第7回　Subプロシージャでユーザー独自の処理を定義する：基礎解説演習方式で身につけるチェック式WSH超入門（3/3 ページ）

» 2006年12月07日 00時00分公開

[牟田口大介（Microsoft MVP　Visual Developer - Scripting），著]

複数の引数を取るSubプロシージャ

　引数は1つではなく複数取ることもできる。第3回で登場したBMI（Body Mass Index、肥満度の判定に用いる指数）を求めるスクリプトをSubプロシージャ化したものが次のコードである。

Option Explicit

Call ShowBMI(CDbl(1.75), CDbl(60)) '身長175cm、体重60kg
Call ShowBMI(0, 0) '無効なデータ
Call ShowBMI(CDbl(1.80), CDbl(91)) '身長180cm、体重91kg

'*********************************************************
'用途: 与えられた身長と体重から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

        'BMIを求める（小数点以下2位で丸める）
        Dim dblBMI
        dblBMI = Round(dblWeight / (dblHeight * dblHeight) ,2)

        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

　このスクリプトを実行すると、次のような3つのメッセージ・ボックスが連続して表示される。

SubプロシージャShowBMIを実行した例
BMIの値を計算する部分をSubプロシージャ化し、それを3回呼び出している。

　ここではdblHeightに身長、dblWeightに体重の値を与えて、SubプロシージャShowBMIを3回呼び出している。ここで注意が必要なのは、実引数の数と仮引数の数は一致している必要がある点である。

　SubプロシージャShowBMIの前半部分では、与えられた引数が正しい値かどうかを判断している。dblHeight およびdblWeight がDouble型でないか、dblHeight が0（コード中にdblHeightで割るところがあるので、0で割るとエラーになる）だと、警告メッセージを表示した後Exitステートメントを用いSubプロシージャを抜ける。このExitステートメントはFor～Nextステートメントの解説で登場したものと同様であり、Exitした後のコードは実行されず、呼び出し元の次の行に制御を移す。この場合、BMIを計算する部分は実行されないことになる。

　残りの部分は実際にBMIを計算し、Ifステートメントで肥満・やせ・標準を判定しているのだが特に説明は必要ないだろう。

カレンダーを出力するSubプロシージャ

　ここでSubプロシージャのおさらいをするための例題を1つ取り上げる。指定した日の含まれる月のカレンダーを出力するスクリプトを考えてみよう。ここでは、カレンダーを表示する部分をSubプロシージャ化し（ShowCalendarという名前を付ける）、引数に日付を受け取るようにしたい。

マーカーで隠れたところを選択してチェックしてみよう。

Option Explicit

Call ShowCalendar(Date) '今月のカレンダーを表示する。
Call ShowCalendar(#2007/12#) '2007年12月のカレンダーを表示する。

'*********************************************************
'用途: 与えられた日付が含まれる月のカレンダーを作成し表示する。
'受け取る値: dtmDate: 日付(Date)
'戻り値: なし
'*********************************************************
Sub ShowCalendar(dtmDate)
    Dim dtm1stDate, intLastDay, intOffset, strCalendar

    'もし与えられた引数がDate型でなければSubプロシージャを終了する
     If Not IsDate(dtmDate) Then Exit Sub

    '月の最初の日付を取得
    dtm1stDate = DateSerial(Year(dtmDate), Month(dtmDate), 1)
    '月の最後の日を取得（次月の最初の日の1日前）
    intLastDay = Day(DateAdd("d", -1, DateAdd("m", 1, dtm1stDate)))
    '月の最初の日の曜日＝1週目のオフセットを取得
    intOffset = WeekDay(dtm1stDate, vbSunday)
    'カレンダーのヘッダ部分（年/月）を変数に代入
    strCalendar = Year(dtmDate) & "/" & Month(dtmDate) & vbCrLf & vbCrLf
    'カレンダーの曜日名を変数に代入
    strCalendar = strCalendar & _
    Join(Split("日,月,火,水,木,金,土", ","), vbTab) & vbCrLf & vbCrLf

    Dim intCounterDay, intCounterWeek, intTempDay

    intTempDay = 1 '1日ごとに加算されるカウンタ

    '週ごとに回されるカウンタ
    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

    '変数の中身を表示
    MsgBox strCalendar
End Sub