[[20060814160809]]　『VBAで年間カレンダー作成』（なーさん）　ページの最後に飛ぶ

『VBAで年間カレンダー作成』（なーさん）

VBAで年間のカレンダー(2007年版)を1シートで12か月分を表示させるのをつくってます。
あと、Tateichi()、Yokoichi(）、Hajime()、Nissu()、Shukujitu()、の５つの関数プログラム
をつくるようなのですが関数のプログラムの返す書き方が全くわからなくて困っています。
以下メインのソースを貼ります。よろしくお願いいたします。

OSの種類 WindowsXP　　Excelのバージョン Excel2003

Sub Calender()

  Dim i As Integer
  Dim j As Integer
  Dim x As Integer
  Dim y As Integer
  Dim xx As Integer
  Dim yy As Integer

  For i = 1 To 12 '1月～12月をiという変数で表現する

   x = YokoIchi(i) 'i月のカレンダーの横位置をx
   y = TateIchi(i) 'i月のカレンダーの縦位置をy

   Cells(y, x + 4) = CStr(i) & "月" 'その月の１行目に月の名前を書く

   Cells(y + 2, x + 1) = "日" 'その月の３行目に曜日の見出しを書く
   Cells(y + 2, x + 2) = "月"
   Cells(y + 2, x + 3) = "火"
   Cells(y + 2, x + 4) = "水"
   Cells(y + 2, x + 5) = "木"
   Cells(y + 2, x + 6) = "金"
   Cells(y + 2, x + 7) = "土"
   Cells(y + 2, x + 1).Font.ColorIndex = 3
   Cells(y + 2, x + 7).Font.ColorIndex = 5

   xx = Hajime(i) - 1 'xxで曜日(1～7)を表現する
                  'i月の初めの曜日を代入し、１を引いておく
   yy = 3 'その月の４行目から日を書く

   For j = 1 To Nissu(i) 'jという変数で日を表現する
    xx = xx + 1 '曜日を進める
    If xx = 8 Then '曜日が7を超えた場合の処理
       xx = 1
       yy = yy + 1
    End If
    Cells(y + yy, x + xx) = j '日を書く

    Select Case xx
      Case 1  '日曜日の色
       Cells(y + yy, x + xx).Font.ColorIndex = 3
      Case 7  '土曜日の色
       Cells(y + yy, x + xx).Font.ColorIndex = 5
      Case Else 'その他の色
       Cells(y + yy, x + xx).Font.ColorIndex = 1
    End Select

    If Shukujitu(i, j) = "Yes" Then
       Cells(y + yy, x + xx).Font.ColorIndex = 3
    End If

   Next j
  Next i

End Sub

 >関数のプログラムの返す書き方が全くわからなくて
 これは関数を呼び出すってことでしょうか。
 であれば、必要な場所でCallします。
 Call Tateichi

 （川野鮎太郎）

 正直、もう少し簡単に出来そうな気がします、、、
 時間が無かったのですが、練習のため少し弄ってみました。
 こんな感じなのでしょうか？
　
 ※ちなみに、質問の「５つの関数プログラム」には何もかすっていません・・・
 　Shukujituに関しては、無視しちゃってますｗ
 　必要であれば、Shukujituと言う名の配列で(12,31)分用意し、
 　祭日にのみ "Yes" と入れておく必要があります。
　
Sub Calender2()
Dim i As Integer, j As Integer, x As Integer, y As Integer
Dim xx As Integer, yy As Integer, MyY As Integer, Nissu As Integer
    MyY = 2006
    For i = 1 To 12 '1月～12月をiという変数で表現する
        x = ((i - 1) * 8) + 1 'i月のカレンダーの横位置をx
        y = 1 'i月のカレンダーの縦位置をy
        Cells(y, x + 4) = CStr(i) & "月" 'その月の１行目に月の名前を書く
        Cells(y + 2, x + 1).Resize(, 7) = Array("日", "月", "火", "水", "木", "金", "土") _
            'その月の３行目に曜日の見出しを書く
        Cells(y + 2, x + 1).Font.ColorIndex = 3
        Cells(y + 2, x + 7).Font.ColorIndex = 5
        xx = Weekday(DateSerial(MyY, i, 1)) - 1 'xxで曜日(1～7)を表現する
                       'i月の初めの曜日を代入し、１を引いておく
        yy = 3 'その月の４行目から日を書く
        Nissu = Day(DateSerial(MyY, i + 1, 0))
        For j = 1 To Nissu 'jという変数で日を表現する
            xx = xx + 1 '曜日を進める
            If xx = 8 Then '曜日が7を超えた場合の処理
                xx = 1
                yy = yy + 1
            End If
            Cells(y + yy, x + xx) = j '日を書く
            Select Case xx
                Case 1  '日曜日の色
                    Cells(y + yy, x + xx).Font.ColorIndex = 3
                Case 7  '土曜日の色
                    Cells(y + yy, x + xx).Font.ColorIndex = 5
                Case Else 'その他の色
                    Cells(y + yy, x + xx).Font.ColorIndex = 1
            End Select
            'If Shukujitu(i, j) = "Yes" Then
            '    Cells(y + yy, x + xx).Font.ColorIndex = 3
            'End If
        Next j
    Next i
    Cells.ColumnWidth = 3
End Sub
　
 （キリキ）（〃⌒o⌒)b

＞川野鮎太郎さま

＞これは関数を呼び出すってことでしょうか。

説明文不足で大変すみません｡関数を呼び出すといいますか､､､関数で返す感じですかね｡

引数を使って｡戻り値として返す仕組みだと思っております｡ subプロシージャでなくFunctionプロシージャで書かないといけないと思うのですがその仕組みもよくわからなくて困っております｡

申し訳ありません｡なにかご協力できるようでしたらよろしくお願いいたします｡

＞キリキさま

ご多忙で時間が無い中､触れてくださったことには頭が下がります｡

ありがとうございます｡はい､製作の形としてはVBAだけで表示なのでそのような感じですね｡
ソースをうまくまとめてくださり､感謝致します｡

subだけでも祝日設定なくても表示可能なんですね｡驚きました｡

カレンダーを2ヶ月づつ下のほうに表示させ下のほうにスクロールしていくような表示方法はございますかね？

これが、Tateichi(),Yokoichi()での設定でやるのかな・・・

１月　２月

３月　４月

５月　．．．

11月　12月

このような感じに最終的には位置表示させたいです｡

うまく良い感じで表示はできているので､残りこの表示方と祝祭日の設定ですかね｡

不要な部分や省略の仕方などまとめ方は勉強になります｡ありがとうございます｡

またお力をお借りできましたらよろしくお願い致します｡

 >カレンダーを2ヶ月づつ下のほうに表示させ下のほうにスクロールしていくような表示方法はございますかね？
 そうなると、こんな感じでいかが？
　
Sub Calender3()
Dim i As Integer, j As Integer, x As Integer, y As Integer
Dim xx As Integer, yy As Integer, MyY As Integer, Nissu As Integer
    MyY = 2006
    For i = 1 To 12 '1月～12月をiという変数で表現する
        x = IIf(i Mod 2 = 0, 9, 1) 'i月のカレンダーの横位置をx
        y = ((Int((i - 1) / 2)) * 9) + 1  'i月のカレンダーの縦位置をy
        Cells(y, x + 4) = CStr(i) & "月" 'その月の１行目に月の名前を書く
        Cells(y + 2, x + 1).Resize(, 7) = Array("日", "月", "火", "水", "木", "金", "土") _
            'その月の３行目に曜日の見出しを書く
        Cells(y + 2, x + 1).Font.ColorIndex = 3
        Cells(y + 2, x + 7).Font.ColorIndex = 5
        xx = Weekday(DateSerial(MyY, i, 1)) - 1 'xxで曜日(1～7)を表現する
                       'i月の初めの曜日を代入し、１を引いておく
        yy = 3 'その月の４行目から日を書く
        Nissu = Day(DateSerial(MyY, i + 1, 0))
        For j = 1 To Nissu 'jという変数で日を表現する
            xx = xx + 1 '曜日を進める
            If xx = 8 Then '曜日が7を超えた場合の処理
                xx = 1
                yy = yy + 1
            End If
            Cells(y + yy, x + xx) = j '日を書く
            Select Case xx
                Case 1  '日曜日の色
                    Cells(y + yy, x + xx).Font.ColorIndex = 3
                Case 7  '土曜日の色
                    Cells(y + yy, x + xx).Font.ColorIndex = 5
                Case Else 'その他の色
                    Cells(y + yy, x + xx).Font.ColorIndex = 1
            End Select
            'If Shukujitu(i, j) = "Yes" Then
            '    Cells(y + yy, x + xx).Font.ColorIndex = 3
            'End If
        Next j
    Next i
    Cells.ColumnWidth = 3
End Sub
　
 殆ど、最初に提示いただいたものを編集しただけですから
 主なコードの変更はしていませんが、、、
 うまくすれば、もっとコードを短く出来そうな気がします。
　
 （キリキ）（〃⌒o⌒)b

 >Tateichi()、Yokoichi(）、Hajime()、Nissu()、Shukujitu()、の５つの
 >関数プログラムをつくるようなのですが
 これらの関数は、必ず必要ですか？

 >説明文不足で大変すみません｡関数を呼び出すといいますか､､､関数で返す感じですかね｡ 
 >引数を使って｡戻り値として返す仕組みだと思っております｡
 >subプロシージャでなくFunctionプロシージャで書かないといけないと思うのですが
 >その仕組みもよくわからなくて困っております｡ 
 Functionからどうやって値を返すのかがわからない、ということですか？

＞これらの関数は、必ず必要ですか？

必ずしもっという状況でもないのですが、日数を返す関数や祝祭日を返す関数は出来れば関数の処理で行いたいです。

＞Functionからどうやって値を返すのかがわからない、ということですか？

そうですね。おっしゃるとおりです。処理を実行する書き方がいまいち不透明でして、値を代入して呼び出し元に値を返すFunctionの基本的なる機能（？）利用する関数の表し方がわからなくて困っております。

＞キリキさま

素晴らしいですね。　少し変えるだけで理想系の処理（表示）にかなり近づく事が出来てます。大変感謝しております。

 >日数を返す関数や祝祭日を返す関数は出来れば関数の処理で行いたいです。
 関数にするなら、キリキさんのコードを分割すれば良いと思います。
Function Nissu(Nen As Integer, Tuki As Integer) As Integer
    Nissu = Day(DateSerial(Nen, Tuki + 1, 0))
End Function
 こんな感じで。

 祝祭日を返すのは私にはわからないですね。
 ちょっと検索してみると、こういうものは見つかりましたが。
http://homepage1.nifty.com/ht_deko/tech004.html

＞関数にするなら、キリキさんのコードを分割すれば良いと思います。

分割するという手もあるんですね。Nen,Tukiという宣言も思い浮かばなかった・・・
Nissuは出来ました。ありがとうございます。

祝祭日は月と日に基づいて、祝祭日かどうかを判断して、もし祝祭日ならば"Yes"(色を赤で)を戻り値とするような関数なんですがうまい具合に処理ができないですね。。

参考にしながらもう少しがんばってみます！
またお力になられるようでありましたらよろしくお願いいたします。

（なーさん）

 >祝祭日は月と日に基づいて、祝祭日かどうかを判断して、
  月と日だけで判断できるものなんでしょうか。

 >もし祝祭日ならば"Yes"(色を赤で)を戻り値とするような
 (色を赤で)の意味がわかりませんが
 どちらかといえば、文字列を返すよりBooleanのほうが良いような気がします。

 もし2007年に限定するなら、べた書きでもいいかもしれないですね。

お盆時期もあっておそくなってすみません。

関数名はshukujituで、引数は月(i)と日(j)
shukujituは、月と日に基づいて、祝祭日かどうかを判断し、もし祝祭日ならば"Yes"を戻り値とするプログラムみたいなんです。

途中まで形として

Function shukujitu(Tuki as Integer, Hi as Integer) as String
Dim TukiHi as String

TukiHi = CStr(tuki) & "/" & CStr(Hi)

Select Case TukiHi

  Case ．．．．

    shukujitu = "Yes"
  Case Else
    shukujitu = "No"

End Select

End Function

このSelect Case文の条件式をなんとか解読できないでしょうか？
よろしくお願いいたします。
（なーさん）

 　
Function shukujitu(Tuki As Integer, Hi As Integer) As String
    Dim TukiHi As String
    TukiHi = CStr(Tuki) & "/" & CStr(Hi)

    Select Case TukiHi
    Case "1/1"
        shukujitu = "yes"
    Case "1/8"
        shukujitu = "yes"
　　Case "2/11"
        shukujitu = "yes"
    Case Else
        shukujitu = "No"
    End Select
End Function

 こんな感じで書いていくようになるんでしょうか。

 ↑こちらのコメントは、なーさんですか？
　
 そうすると、まだ解決していないって事ねｂ
　
 上でもσ(^o^;)が書きましたが、
 > ※ちなみに、質問の「５つの関数プログラム」には何もかすっていません・・・
 > 　Shukujituに関しては、無視しちゃってますｗ
 > 　必要であれば、Shukujituと言う名の配列で(12,31)分用意し、
 > 　祭日にのみ "Yes" と入れておく必要があります。
　
 Shukujituと言う配列を用意すればいいような気がします。
 具体的には、「祭日」と言う名のシートを用意してください。
　
	[A]	[B]	[C]	[D]	[E]	[F]	[G]　…
[1]	祭日	1	2	3	4	5	6
[2]	1		Yes				
[3]	2						
[4]	3						
[5]	4						
[6]	5			Yes	Yes	Yes	
[7]	6						
 :
　
 こんな感じです。
 ココに "Yes" と、祭日の部分に入力してください。
 ※振替休日などはご自身で判断してください。
 　ちなみに、２００６年の元旦は日曜日ですので、1/2 を Yes としています。
　
 で、コードもちこっと変更＾＾
　
Sub Calender4()
Dim i As Integer, j As Integer, x As Integer, y As Integer
Dim xx As Integer, yy As Integer, MyY As Integer, Nissu As Integer
Dim Shukujitu As Variant
    MyY = 2006
    With Sheets("祭日")
        Shukujitu = .Range("B2").Resize(12, 31).Value
    End With
    For i = 1 To 12 '1月～12月をiという変数で表現する
        x = IIf(i Mod 2 = 0, 9, 1) 'i月のカレンダーの横位置をx
        y = ((Int((i - 1) / 2)) * 9) + 1  'i月のカレンダーの縦位置をy
        Cells(y, x + 4) = CStr(i) & "月" 'その月の１行目に月の名前を書く
        Cells(y + 2, x + 1).Resize(, 7) = Array("日", "月", "火", "水", "木", "金", "土") _
            'その月の３行目に曜日の見出しを書く
        Cells(y + 2, x + 1).Font.ColorIndex = 3
        Cells(y + 2, x + 7).Font.ColorIndex = 5
        xx = Weekday(DateSerial(MyY, i, 1)) - 1 'xxで曜日(1～7)を表現する
                       'i月の初めの曜日を代入し、１を引いておく
        yy = 3 'その月の４行目から日を書く
        Nissu = Day(DateSerial(MyY, i + 1, 0))
        For j = 1 To Nissu 'jという変数で日を表現する
            xx = xx + 1 '曜日を進める
            If xx = 8 Then '曜日が7を超えた場合の処理
                xx = 1
                yy = yy + 1
            End If
            Cells(y + yy, x + xx) = j '日を書く
            Select Case xx
                Case 1  '日曜日の色
                    Cells(y + yy, x + xx).Font.ColorIndex = 3
                Case 7  '土曜日の色
                    Cells(y + yy, x + xx).Font.ColorIndex = 5
                Case Else 'その他の色
                    Cells(y + yy, x + xx).Font.ColorIndex = 1
            End Select
            If Shukujitu(i, j) = "Yes" Then
                Cells(y + yy, x + xx).Font.ColorIndex = 3
            End If
        Next j
    Next i
    Cells.ColumnWidth = 3
    Erase Shukujitu
End Sub
　
 いかがでしょう？
 （キリキ）（〃⌒o⌒)b

コメント返信：

[ 一覧(最新更新順) ]

[[20060814160809]] 『VBAで年間カレンダー作成』（なーさん） ページの最後に飛ぶ

[[20060814160809]]　『VBAで年間カレンダー作成』（なーさん）　ページの最後に飛ぶ