7曜日×6行で、

日付を代入するテキストボックスと、

備考（=升）を代入するリストボックス

というカレンダーをフォームを作る。ｌ

'-------------------------

Me.Controls("升" & m)

'-------------------------

Function カレンダー表示()

Dim i As Integer 'i=日付

Dim m As Integer 'm=升の番号

Dim 曜日値 As Integer

Dim 月の末日 As Integer

 

'日付の取得

  '曜日の取得 （日曜=1、月曜=2、…、土曜=7）

  曜日値 = Format(Weekday(DateSerial(Me.my年, Me.my月, 1)))

  'その月の末日付の取得

  月の末日 = Format(DateSerial(Me.my年, Me.my月 + 1, 1) - 1, "d")

 

  For i = 1 To 月の末日

  m = 曜日値 + i - 1

  Me.Controls("升" & m) = i

  Next i

 

'カレンダーの1日より前の中身をクリアする

  For m = 1 To 曜日値 - 1

  Me.Controls("升" & m) = ""

  Next m

'カレンダーの末日より後の中身をクリアする

  For m = 曜日値 + 月の末日 To 42

  Me.Controls("升" & m) = ""

  Next m

 

'備考の取得

  For i = 1 To 月の末日

  m = 曜日値 + i - 1

  my日付 = DateSerial(Me.my年, Me.my月, i)

  mySQL = "SELECT 備考 FROM T_テーブル WHERE ((内容 = 'その他') and (日付 = #" & my日付 & "#))"

  Me.Controls("備考" & m).RowSource = mySQL

  Next i

'カレンダーの1日より前の中身をクリアする

  For m = 1 To 曜日値 - 1

  Me.Controls("備考" & m).RowSource = ""

  Next m

'カレンダーの末日より後の中身をクリアする

  For m = 曜日値 + 月の末日 To 42

  Me.Controls("備考" & m).RowSource = ""

  Next m

Me.Refresh

End Function