Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


876 / 2272 ツリー ←次へ | 前へ→

【9611】配列変数の引き渡し方 メイ子 07/6/25(月) 15:40 質問[未読]
【9613】Re:配列変数の引き渡し方 YU-TANG 07/6/26(火) 0:26 回答[未読]
【9621】Re:配列変数の引き渡し方 メイ子 07/6/26(火) 15:38 お礼[未読]
【9616】Re:配列変数の引き渡し方 hatena 07/6/26(火) 2:30 回答[未読]
【9622】Re:配列変数の引き渡し方 メイ子 07/6/26(火) 15:44 質問[未読]
【9624】Re:配列変数の引き渡し方 hatena 07/6/26(火) 20:15 回答[未読]
【9630】Re:配列変数の引き渡し方 メイ子 07/6/28(木) 16:46 質問[未読]
【9631】Re:配列変数の引き渡し方 hatena 07/6/28(木) 21:55 回答[未読]
【9634】Re:配列変数の引き渡し方 メイ子 07/6/29(金) 11:22 質問[未読]
【9635】Re:配列変数の引き渡し方 hatena 07/6/30(土) 8:09 回答[未読]
【9643】Re:配列変数の引き渡し方 メイ子 07/7/2(月) 21:05 質問[未読]
【9659】Re:配列変数の引き渡し方 hatena 07/7/5(木) 10:56 回答[未読]
【9660】Re:配列変数の引き渡し方 メイ子 07/7/5(木) 14:49 質問[未読]
【9662】Re:配列変数の引き渡し方 hatena 07/7/5(木) 21:45 回答[未読]
【9666】Re:配列変数の引き渡し方 メイ子 07/7/6(金) 17:39 質問[未読]
【9670】Re:配列変数の引き渡し方 hatena 07/7/7(土) 11:08 回答[未読]
【9676】Re:配列変数の引き渡し方 メイ子 07/7/9(月) 11:05 質問[未読]
【9677】Re:配列変数の引き渡し方 hatena 07/7/9(月) 11:38 回答[未読]
【9682】Re:配列変数の引き渡し方 メイ子 07/7/10(火) 14:20 質問[未読]
【9683】Re:配列変数の引き渡し方 hatena 07/7/10(火) 14:40 回答[未読]
【9685】Re:配列変数の引き渡し方 メイ子 07/7/10(火) 19:03 質問[未読]
【9689】Re:配列変数の引き渡し方 hatena 07/7/11(水) 13:31 回答[未読]
【9691】Re:配列変数の引き渡し方 メイ子 07/7/11(水) 14:01 お礼[未読]
【9703】Re:配列変数の引き渡し方 メイ子 07/7/21(土) 12:23 質問[未読]
【9704】Re:配列変数の引き渡し方 hatena 07/7/21(土) 22:20 回答[未読]
【9705】Re:配列変数の引き渡し方 メイ子 07/7/23(月) 12:01 質問[未読]
【9706】Re:配列変数の引き渡し方 hatena 07/7/23(月) 15:31 回答[未読]
【9708】Re:配列変数の引き渡し方 メイ子 07/7/25(水) 15:10 質問[未読]
【9709】Re:配列変数の引き渡し方 hatena 07/7/26(木) 9:51 回答[未読]
【9712】Re:配列変数の引き渡し方 メイ子 07/7/26(木) 18:20 お礼[未読]

【9611】配列変数の引き渡し方
質問  メイ子  - 07/6/25(月) 15:40 -

引用なし
パスワード
   こんにちは。メイ子と申します。
いろいろ探してみましたが、どうしてもわかりませんでしたので、どなたかご教示お願いいたします。

曜日ごとや出席日だけ色を変えたかったので、カレンダーコントロールが使えないため、小さなラベルを7列6段分つなげて6ヶ月分(3ヶ月前〜2ヶ月後)作り、ラベル名をa1〜a42・・・f1〜f42としました。毎月同じフォームを使えるようにラベルの日にちはループでロードしたときにセットされます。
同じフォーム内に日付を入力するテキストボックス1があり、上記ラベルの一つをクリックすると、カレンダーコントロールのように日付が入力されるようにしたいのですが、ラベルには日にちだけ表示しているので、実際の年月日のデータはテキストボックス1に入りません。よって、配列変数に年月日のデータを入れるようにしてみましたが、例えば、ラベル「d14」をクリックしたときにその配列変数の(3,14)番目の値をテキストボックス1に入れられるようにするにはどうしたらよいでしょうか?

Private Sub form_load()

Dim tsuki(5) As String
  tsuki(0) = "a"
  tsuki(1) = "b"
  tsuki(2) = "c"
  tsuki(3) = "d"
  tsuki(4) = "e"
  tsuki(5) = "f"
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim p As Variant
Dim aaa As String
Dim bbb As String
 
  j = 0
  p = DateSerial(Year(DateAdd("m", -3, Date)), _
    Month(DateAdd("m", -3, Date)), 1)
    
    For j = 0 To 5
      For i = Weekday(Month(DateAdd("m", -3 + j, Date)) & "/" & 1) _
          To Day(DateSerial(Year(DateAdd("m", -2 + j, Date)), _
          Month(DateAdd("m", -2 + j, Date)), 0)) + _
          Weekday(Month(DateAdd("m", -3 + j, Date)) & "/" & 1) _
          - 1
        Me(tsuki(j) & i).Caption = Day(p)
        aaa = aaa & "," & p
        p = p + 1
      Next i
      p = DateSerial(Year(DateAdd("m", -3 + j + 1, Date)), _
        Month(DateAdd("m", -3 + j + 1, Date)), 1)
      bbb = bbb & "," & j
      avarData = Array(Mid(bbb, 2), Mid(aaa, 2))
    Next j

End Sub

↓ここで「イベントプロパティに指定した式読み込み時でエラーが発生しました。プロジージャの宣言がイベントまたはプロシージャの定義と一致していません」
というエラーがでます。
Private Sub d14_Click(ByRef avarData())
 
  Me.ActiveControl.Value = avarData(3, 14)

End Sub

【9613】Re:配列変数の引き渡し方
回答  YU-TANG  - 07/6/26(火) 0:26 -

引用なし
パスワード
   こんばんは、YU-TANG です。

> というエラーがでます。
> Private Sub d14_Click(ByRef avarData())

これ、ラベルですよね。
ラベルのクリック時イベントに avarData という引数はありません。
勝手に追加しても、認識してくれるわけではありません。

直接の回答にはなっていないと思いますが、こういう場合は
WithEvents とクラスで実装するのが定石です。

まずクラスモジュールを挿入して、以下のように記述します。

Option Compare Database
Option Explicit

Private WithEvents lbl As Access.Label

Private Sub Class_Terminate()
  Set lbl = Nothing
End Sub

Public Property Set Label(ByVal vNewValue As Access.Label)
  Set lbl = vNewValue
  lbl.OnClick = "[Event Procedure]"
End Property

Private Sub lbl_Click()
  Screen.ActiveControl.Value = lbl.Tag
End Sub

クラスモジュール名は任意ですが、とりあえずここでは「clsDateLabel」
という名前を付けたと仮定します。

次に、フォームの(クラス)モジュール先頭で次のように宣言。

Option Compare Database
Option Explicit

Dim dic As Object ' クラス保持用 Dictionary オブジェクト

Private Sub Form_Close()
  Set dic = Nothing
End Sub

最後に、Form_Load() のループ中で次のように初期化します。

> Me(tsuki(j) & i).Caption = Day(p)
Me(tsuki(j) & i).Tag = p
Set dic(tsuki(j) & i) = New clsDateLabel ' インスタンス作成
Set dic(tsuki(j) & i).Label = Me(tsuki(j) & i)

これで、ラベルのクリック時イベントプロシージャを個別に
作成しなくても、クラスが勝手に処理してくれるはずです。

それでは。

【9616】Re:配列変数の引き渡し方
回答  hatena  - 07/6/26(火) 2:30 -

引用なし
パスワード
   YU-TANG さんから、クラスを使う方法が紹介されてますが、
この程度なら、クラスを使わなくても、
OnClickに、関数を設定する方法で同じ事を実現できます。
イベントの引数を利用したいときなどはクラスでないと無理ですが。

以前、似たような物を作ったことが有りますので、
そのときのコードの今回の仕様に合わせて変更したものを
出しておきます。参考にしてください。

フォームモジュール

Private Function Day_Click(D As Date)
  Screen.ActiveControl.Value = D
End Function

Private Function SetCalendar(y As Integer, m As Integer)
' y年m月の3ヶ月前から2ヶ月後までのカレンダーの日付を設定
Dim i As Integer, j As Integer, FirstDay As Date, s As Integer

For j = -3 To 2
  FirstDay = DateSerial(y, m + j, 1)
  s = Weekday(FirstDay)
  For i = 0 To Day(DateSerial(y, m + j + 1, -1))
    With Me(Chr(Asc("E") + j) & i + s)
      .Caption = Day(FirstDay + i)
      .OnClick = "=Day_Click(#" & FirstDay + i & "#)"
    End With
  Next
Next

End Function

Private Sub Form_Load()
  SetCalendar Year(Date), Month(Date)
End Sub


フォームの読み込みに、ラベルのクリック時プロパティにDay_Click関数を設定してます。
そのときに日付を引数として渡してます。

【9621】Re:配列変数の引き渡し方
お礼  メイ子  - 07/6/26(火) 15:38 -

引用なし
パスワード
   ▼YU-TANG さん
ご丁寧にご教示頂き、ありがとうございます。
クラスという概念は、耳にしたことはありますが、かなり難しそうですね。
でも、すべてのラベル(42×6ヶ月分)にクリック時イベントを作成しなくてもよくなるということなんですね?
ちょっと時間がかかりますが、勉強してみます。
わからないところがありましたら、また質問させて頂きますので、よろしくお願いいたします。

>こんばんは、YU-TANG です。
>
>> というエラーがでます。
>> Private Sub d14_Click(ByRef avarData())
>
>これ、ラベルですよね。
>ラベルのクリック時イベントに avarData という引数はありません。
>勝手に追加しても、認識してくれるわけではありません。
>
>直接の回答にはなっていないと思いますが、こういう場合は
>WithEvents とクラスで実装するのが定石です。
>
>まずクラスモジュールを挿入して、以下のように記述します。
>
>Option Compare Database
>Option Explicit
>
>Private WithEvents lbl As Access.Label
>
>Private Sub Class_Terminate()
>  Set lbl = Nothing
>End Sub
>
>Public Property Set Label(ByVal vNewValue As Access.Label)
>  Set lbl = vNewValue
>  lbl.OnClick = "[Event Procedure]"
>End Property
>
>Private Sub lbl_Click()
>  Screen.ActiveControl.Value = lbl.Tag
>End Sub
>
>クラスモジュール名は任意ですが、とりあえずここでは「clsDateLabel」
>という名前を付けたと仮定します。
>
>次に、フォームの(クラス)モジュール先頭で次のように宣言。
>
>Option Compare Database
>Option Explicit
>
>Dim dic As Object ' クラス保持用 Dictionary オブジェクト
>
>Private Sub Form_Close()
>  Set dic = Nothing
>End Sub
>
>最後に、Form_Load() のループ中で次のように初期化します。
>
>> Me(tsuki(j) & i).Caption = Day(p)
>Me(tsuki(j) & i).Tag = p
>Set dic(tsuki(j) & i) = New clsDateLabel ' インスタンス作成
>Set dic(tsuki(j) & i).Label = Me(tsuki(j) & i)
>
>これで、ラベルのクリック時イベントプロシージャを個別に
>作成しなくても、クラスが勝手に処理してくれるはずです。
>
>それでは。

【9622】Re:配列変数の引き渡し方
質問  メイ子  - 07/6/26(火) 15:44 -

引用なし
パスワード
   ▼hatena さん
丁寧にお教え頂きありがとうございます。

>YU-TANG さんから、クラスを使う方法が紹介されてますが、
>この程度なら、クラスを使わなくても、
>OnClickに、関数を設定する方法で同じ事を実現できます。

はい、クラスを使う方法をマスターするには少し時間がかかりそうですので、まずはこちらから勉強させて頂きたいと思います。

>以前、似たような物を作ったことが有りますので、
>そのときのコードの今回の仕様に合わせて変更したものを
>出しておきます。参考にしてください。

ありがとうございます。
最初の説明のところに少し書きましたが、この方法で(テーブルの出席日フィールドのデータと比べて)ラベルの色を変えることも可能でしょうか?

>
>フォームモジュール
>
>Private Function Day_Click(D As Date)
>  Screen.ActiveControl.Value = D
>End Function
>
>Private Function SetCalendar(y As Integer, m As Integer)
>' y年m月の3ヶ月前から2ヶ月後までのカレンダーの日付を設定
>Dim i As Integer, j As Integer, FirstDay As Date, s As Integer
>
>For j = -3 To 2
>  FirstDay = DateSerial(y, m + j, 1)
>  s = Weekday(FirstDay)
>  For i = 0 To Day(DateSerial(y, m + j + 1, -1))
>    With Me(Chr(Asc("E") + j) & i + s)
>      .Caption = Day(FirstDay + i)
>      .OnClick = "=Day_Click(#" & FirstDay + i & "#)"
>    End With
>  Next
>Next
>
>End Function
>
>Private Sub Form_Load()
>  SetCalendar Year(Date), Month(Date)
>End Sub
>
>
>フォームの読み込みに、ラベルのクリック時プロパティにDay_Click関数を設定してます。
>そのときに日付を引数として渡してます。

【9624】Re:配列変数の引き渡し方
回答  hatena  - 07/6/26(火) 20:15 -

引用なし
パスワード
   >ありがとうございます。
>最初の説明のところに少し書きましたが、この方法で(テーブルの出席日フィールドのデータと比べて)ラベルの色を変えることも可能でしょうか?

当然、可能です。ループ内で、Caption や OnClickプロパティの設定をしてますが、
そこで、条件に応じて、BackColorの設定をすればいいだけです。

【9630】Re:配列変数の引き渡し方
質問  メイ子  - 07/6/28(木) 16:46 -

引用なし
パスワード
   ▼hatena さん
ご教示ありがとうございます。onclickは完璧に作動しました。感激のレスポンスの早さです。ありがとうございました。
後、下記ご指導頂いた部分を作ってみました。
>当然、可能です。ループ内で、Caption や OnClickプロパティの設定をしてますが、
>そこで、条件に応じて、BackColorの設定をすればいいだけです。

生徒さんごとで色を変える受講曜日や出席日が違うので、今度は
Form_Current()のイベントに下記Function SetColorを呼び出す形にしてみたのですが、FormatConditions.Addの行で「オブジェクトはこのプロパティまたはメソッドをサポートしていません」と出ます。どこを直したらよろしいでしょうか?
あるいは、根本的に間違っているかも知れませんが、よろしくご指導お願いいたします。(まずは、出席日の色変えの部分だけです。)


Private Function SetColor(y As Integer, m As Integer)
Dim i As Integer, j As Integer, FirstDay As Date, s As Integer
Dim db As DAO.Database
Dim RS As DAO.Recordset

  Set db = CurrentDb()
  Set RS = db.OpenRecordset("出欠", dbOpenTable)
  Do Until RS.EOF
    If RS!生徒番号 = Me.生徒番号 Then
      For j = -3 To 2
        FirstDay = DateSerial(y, m + j, 1)
        s = Weekday(FirstDay)
        For i = 0 To Day(DateSerial(y, m + j + 1, -1))
          With Me(Chr(Asc("D") + j) & i + s)
            .FormatConditions.Add(acExpression, , _
            "#" & FirstDay + i & "# =" & RS!出席日) _
            .BackColor = RGB(112, 252, 175)
          End With
        Next
      Next
    End If
    RS.MoveNext
  Loop
End Function

Private Sub Form_Current()
  SetColor Year(Date), Month(Date)
End Sub

【9631】Re:配列変数の引き渡し方
回答  hatena  - 07/6/28(木) 21:55 -

引用なし
パスワード
   >生徒さんごとで色を変える受講曜日や出席日が違うので、今度は
>Form_Current()のイベントに下う記Function SetColorを呼び出す形にしてみたのですが、FormatConditions.Addの行で「オブジェクトはこのプロパティまたはメソッドをサポートしていません」と出ます。どこを直したらよろしいでしょうか?
>あるいは、根本的に間違っているかも知れませんが、よろしくご指導お願いいたします。(まずは、出席日の色変えの部分だけです。)

ラベルなんですよね。ラベルにFormatConditions(条件付き書式)はないし、
また背景色を変更するだけなら、条件付き書式を使う必要はないです。

また、コード自体も、意味不明ですね。
すべてのラベルを同じ色に設定するコードをくり返しているだけです。

とりあえず、もう少し情報が必要ですね。

フォームは単票フォームですよね。
Form_Currentのイベントを使うと言うことは、連結フォームなんですよね。
フォームのレコードソースのテーブル(またはクエリ)はどのようなものですか。

また、「出欠」テーブルに生徒の出欠履歴が入っているようですが、
どのようなフィールド構成ですか。データ例も出して説明してもらえると
状況を把握しやすいです。

【9634】Re:配列変数の引き渡し方
質問  メイ子  - 07/6/29(金) 11:22 -

引用なし
パスワード
   ▼hatena さん
ご指導ありがとうございます。以下のような内容でフォームを作っています。

>フォームは単票フォームですよね。
>Form_Currentのイベントを使うと言うことは、連結フォームなんですよね。
>フォームのレコードソースのテーブル(またはクエリ)はどのようなものですか。

フォームは表形式で、連結フォームです。
テーブル名(レコードソース):「名簿管理」
フィールド名:生徒番号  1
       氏名    松井
       フリガナ  マツイ
       クラス   初級
       曜日    火曜日
       出欠    yes, no
       出席日   空
       振替予定日 空
       振替出席日 空
フォームのヘッダー部分で、クラスと曜日を検索し、詳細部分で一覧を表示しています。また、そのヘッダー部分にカレンダーコントロールもどきを6つ配置しています。

>また、「出欠」テーブルに生徒の出欠履歴が入っているようですが、
>どのようなフィールド構成ですか。データ例も出して説明してもらえると
>状況を把握しやすいです。

テーブル名:「出欠」
フィールド名:生徒番号 1
       出席日  2007/06/05
       出欠   yes, no
これを読み込んで、Form_Currentで生徒ごとの受講曜日と出席日を色分けしたいと思っています。「名簿管理」はマスターテーブルなので、出席日、振替予定日、振替出席日のフィールドは仮入力用で、実際の出席日、振替予定日、振替出席日は、「出欠」テーブルに入力していきたいのです。

どうぞよろしくお願いいたします。

【9635】Re:配列変数の引き渡し方
回答  hatena  - 07/6/30(土) 8:09 -

引用なし
パスワード
   >これを読み込んで、Form_Currentで生徒ごとの受講曜日と出席日を色分けしたいと思っています。


どのような色分けか分からないので、とりあえず、
出席日 の 出欠 がTrueの時は、青、Falseの時は 赤、それ以外は白 という
条件で背景色を設定する例です。

Private Sub SetColor(y As Integer, m As Integer)
Dim i As Integer, j As Integer
Dim db As DAO.Database
Dim RS As DAO.Recordset
Dim strSQL As String
  strSQL = "SELECT * FROM 出欠 " & _
      "WHERE 生徒番号=" & Me.生徒番号 & " AND " & _
      "出席日 Between #" & DateSerial(y, m + 0, 1) & _
      "# AND #" & DateSerial(y, m + 2, 0) & "#"
  Set db = CurrentDb()
  Set RS = db.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
  
  For j = 0 To 1
    For i = 1 To 42
      With Me(Chr(Asc("d") + j) & i)
        If .OnClick= "" Then
          .BackColor = vbWhite
        Else
          RS.FindFirst "出席日=#" & Split(.OnClick,"#")(1) & "#"
          If RS.NoMatch Then
            .BackColor = vbWhite
          ElseIf RS!出欠 Then
            .BackColor = vbBlue
          Else
            .BackColor = vbRed
          End If
        End If
      End With
    Next
  Next
  RS.Close
End Sub

Private Sub Form_Current()
  SetColor Year(Date), Month(Date)
End Sub

【9643】Re:配列変数の引き渡し方
質問  メイ子  - 07/7/2(月) 21:05 -

引用なし
パスワード
   ▼hatena さん
丁寧なご教示ありがとうございます。

丸々コピペさせて頂き、動作させてみましたところ、
「インデックスが有効範囲にありません」というエラーが
RS.FindFirst "出席日=#" & Split(.OnClick,"#")(1) & "#"
のところで出ます。
原因を調べてみようと思い、「.onclick」の使い方をあちこち検索してみましたが、わかりませんでした。
どこか設定が間違っているのか、考えられる原因がありましたら、もう一度ご教示お願いいたします。

>どのような色分けか分からないので、とりあえず、
>出席日 の 出欠 がTrueの時は、青、Falseの時は 赤、それ以外は白 という
>条件で背景色を設定する例です。
>
>Private Sub SetColor(y As Integer, m As Integer)
>Dim i As Integer, j As Integer
>Dim db As DAO.Database
>Dim RS As DAO.Recordset
>Dim strSQL As String
>  strSQL = "SELECT * FROM 出欠 " & _
>      "WHERE 生徒番号=" & Me.生徒番号 & " AND " & _
>      "出席日 Between #" & DateSerial(y, m + 0, 1) & _
>      "# AND #" & DateSerial(y, m + 2, 0) & "#"
>  Set db = CurrentDb()
>  Set RS = db.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
>  
>  For j = 0 To 1
>    For i = 1 To 42
>      With Me(Chr(Asc("d") + j) & i)
>        If .OnClick= "" Then
>          .BackColor = vbWhite
>        Else
>          RS.FindFirst "出席日=#" & Split(.OnClick,"#")(1) & "#"
>          If RS.NoMatch Then
>            .BackColor = vbWhite
>          ElseIf RS!出欠 Then
>            .BackColor = vbBlue
>          Else
>            .BackColor = vbRed
>          End If
>        End If
>      End With
>    Next
>  Next
>  RS.Close
>End Sub
>
>Private Sub Form_Current()
>  SetColor Year(Date), Month(Date)
>End Sub

【9659】Re:配列変数の引き渡し方
回答  hatena  - 07/7/5(木) 10:56 -

引用なし
パスワード
   >丸々コピペさせて頂き、動作させてみましたところ、
>「インデックスが有効範囲にありません」というエラーが
>RS.FindFirst "出席日=#" & Split(.OnClick,"#")(1) & "#"
>のところで出ます。
>原因を調べてみようと思い、「.onclick」の使い方をあちこち検索してみましたが、わかりませんでした。
>どこか設定が間違っているのか、考えられる原因がありましたら、もう一度ご教示お願いいたします。

9616 で回答したコードは設定してありますよね。

下記のようにエラーの出る行の前に、デバッグコードを埋め込んで
実行してみてイミディエイトウィンドウに
出力されたログをコピーして張り付けてもらえますか。

 Else
  Debug.Print .OnClick 'デバッグコード
  RS.FindFirst "出席日=#" & Split(.OnClick,"#")(1) & "#"

【9660】Re:配列変数の引き渡し方
質問  メイ子  - 07/7/5(木) 14:49 -

引用なし
パスワード
   ▼hatena さん:
ご教示ありがとうございます。

>9616 で回答したコードは設定してありますよね。
Private Sub Form_Load()
  SetCalendar Year(Date), Month(Date)
End Sub
気づかぬうちに上記部分が消えていましたので、書き直しましたら、エラーはなくなりました。そして、色も出欠テーブルと一致する日にちに赤が表示されるようになりました。ありがとうございました。

今度は曜日ごとの色付けをするために下記3行(下から6行目以降)を追加してみました。.onclickの使い方が把握できていないためか、意味不明なコードになってしまっているようです。
If WeekdayName(Weekday(.OnClick)) = Me.曜日 Then '追加
のところで「型が一致しません」とエラーが出て、
WeekdayName(Weekday(.OnClick)) はウォッチが不正ですと表示されています。
どう直したらよろしいでしょうか?
度々申し訳ありません。よろしくお願いいたします。

For j = 0 To 1
    For i = 1 To 42
      With Me(Chr(Asc("d") + j) & i)
        If .OnClick= "" Then
          .BackColor = vbWhite
        Else
          RS.FindFirst "出席日=#" & Split(.OnClick,"#")(1) & "#"
          If RS.NoMatch Then
            .BackColor = vbWhite
          ElseIf RS!出欠 Then
            .BackColor = vbBlue
          Else
            .BackColor = vbRed
          End If
        End If

        If WeekdayName(Weekday(.OnClick)) = Me.曜日 Then '追加
          .BackColor = vbBlue
        End If

      End With
    Next
  Next

【9662】Re:配列変数の引き渡し方
回答  hatena  - 07/7/5(木) 21:45 -

引用なし
パスワード
   >>9616 で回答したコードは設定してありますよね。
>Private Sub Form_Load()
>  SetCalendar Year(Date), Month(Date)
>End Sub
>気づかぬうちに上記部分が消えていましたので、書き直しましたら、エラーはなくなりました。そして、色も出欠テーブルと一致する日にちに赤が表示されるようになりました。ありがとうございました。
>
>今度は曜日ごとの色付けをするために下記3行(下から6行目以降)を追加してみました。.onclickの使い方が把握できていないためか、意味不明なコードになってしまっているようです。
>If WeekdayName(Weekday(.OnClick)) = Me.曜日 Then '追加
>のところで「型が一致しません」とエラーが出て、


9616の SetCalendar で、各ラベルの OnClickイベントに、例えば、
下記のような式を設定しています。

=Day_Click(#2007/07/01#)

これで、ラベルをクリックすると、日付を取得できるようにしているわけですが、
今回の、SetColor では、この OnClick の式から、日付部分のみを取り出して
検索条件として利用しています。そのコードが、

RS.FindFirst "出席日=#" & Split(.OnClick,"#")(1) & "#"

です。Split(.OnClick,"#") はOnClickの式を # で分割して配列にします。
上の式なら、

=Day_Click( と 2007/07/01 と ) の

の3つに分割されます。その2番目の 2007/07/01 を取り出すのが、

Split(.OnClick,"#")(1)

です。(0)を付けると1番目、(1)を付けると2番目を取得できます。
その結果、

RS.FindFirst "出席日=#2007/07/01#"

となり、出席日が、2007/07/01 のレコードを検索して移動することになります。

これで、私のコードの意味は理解できたでしょうか。

> 今度は曜日ごとの色付けをするために下記3行(下から6行目以降)を追加してみました。.

曜日ごとにどのような仕様で色づけをするのか、3行のコードから読み取ることが
私には出来ません。
すでに、

RS.FindFirst "出席日=#2007/07/01#"

で出席日 2007/07/01 のレコードに移動しているので、日付は、RS!出生日 で取得できますので、
OnClick プロパティを利用する必要はないと思われます。
すでに目的のレコードには移動しているという前提で、メイ子さんの考える仕様に
あわせてコーディングしてください。

【9666】Re:配列変数の引き渡し方
質問  メイ子  - 07/7/6(金) 17:39 -

引用なし
パスワード
   ▼hatena さん:
ご教示ありがとうございます。

>今回の、SetColor では、この OnClick の式から、日付部分のみを取り出して
>検索条件として利用しています。

はい、漠然としていますが、なんとなく意味は理解できました。
clickもしていないのに、click時の値が取得できるというのが、いまひとつ納得できていないのですが、こういう使い方ができるというふうに理解しておけばよいですね。

>(0)を付けると1番目、(1)を付けると2番目を取得できます。
>その結果、
>RS.FindFirst "出席日=#2007/07/01#"

split関数は調べられましたが、(1)の意味がわからなかったので、解説して頂いて助かりました。

>これで、私のコードの意味は理解できたでしょうか。

はい、大変丁寧な解説をして頂いて、本当にありがとうございました。


>曜日ごとにどのような仕様で色づけをするのか、3行のコードから読み取ることが
>私には出来ません。

詳細欄に生徒さんの一覧がある中で、受講日である「曜日」のフィールドがあり、例えば火曜日のクラスの生徒さんなら、currentイベントで、6ヶ月分のカレンダーすべての火曜日に色を付けたいと思いました。
その火曜日中で、出席した日だけを色を濃くするという仕様にしようと思い、まずは、教えて頂いた RS.FindFirst "出席日=#2007/07/01#" のコードが上手く機能しています。

>RS.FindFirst "出席日=#2007/07/01#"
>で出席日 2007/07/01 のレコードに移動しているので、日付は、RS!出生日 で取得できますので、
>OnClick プロパティを利用する必要はないと思われます。

この場合、「出欠」テーブルとは関係なくフォーム中の曜日を読み取って、色付けしたいので、目的のレコードに移動しているという必要はないのでしょうか?
OnClickプロパティで日付のシリアル値から曜日を取得しようとしたのですが、上手くできていないようなのです。

【9670】Re:配列変数の引き渡し方
回答  hatena  - 07/7/7(土) 11:08 -

引用なし
パスワード
   > はい、漠然としていますが、なんとなく意味は理解できました。
> clickもしていないのに、click時の値が取得できるというのが、いまひとつ納得できていないのですが

ちょっと分かりにくいしので、Tagプロパティにも日付を格納するように
CalUpdate を改良しました。これで後から日付を利用するときシンプルな
コードになりますので。

Private Sub CalUpdate(y As Integer, m As Integer)
Dim i As Integer, j As Integer, FirstDay As Date, s As Integer

  For j = 0 To 1
    FirstDay = DateSerial(y, m + j, 1)
    s = Weekday(FirstDay)
    For i = 0 To Day(DateSerial(y, m + j + 1, -1))
      With Me(Chr(Asc("d") + j) & i + s)
        .Caption = Day(FirstDay + i)
        .OnClick = "=Day_Click(#" & FirstDay + i & "#)"
        .Tag = FirstDay + i  '※この行を追加
      End With
    Next
  Next

End Sub

> 詳細欄に生徒さんの一覧がある中で、受講日である「曜日」のフィールドがあり、
> 例えば火曜日のクラスの生徒さんなら、currentイベントで、6ヶ月分のカレンダー
> すべての火曜日に色を付けたいと思いました。
> その火曜日中で、出席した日だけを色を濃くするという仕様にしようと思い、


Private Sub SetColor(y As Integer, m As Integer)
Dim i As Integer, j As Integer
Dim db As DAO.Database
Dim RS As DAO.Recordset
Dim strSQL As String
  strSQL = "SELECT * FROM 出欠 " & _
      "WHERE 生徒番号=" & Me.生徒番号 & " AND " & _
      "出席日 Between #" & DateSerial(y, m + 0, 1) & _
      "# AND #" & DateSerial(y, m + 2, 0) & "#"
  Set db = CurrentDb()
  Set RS = db.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
  
  For j = -3 To 2
    For i = 1 To 42
      With Me(Chr(Asc("d") + j) & i)
        If .OnClick= "" Then
          .BackColor = vbWhite
        Else
          RS.FindFirst "出席日=#" & .Tag & "#")(1) & "#"
          If RS.NoMatch Then
            If WeekdayName(Weekday(.Tag)) = Me.曜日 Then
              .BackColor = vbMagenta
            Else
              .BackColor = vbWhite
            End If
          ElseIf RS!出欠 Then
            .BackColor = vbBlue
          Else
            .BackColor = vbRed
          End If
        End If
      End With
    Next
  Next
  RS.Close
End Sub

【9676】Re:配列変数の引き渡し方
質問  メイ子  - 07/7/9(月) 11:05 -

引用なし
パスワード
   ▼hatena さん:
丁寧なご教示ありがとうございます。

>ちょっと分かりにくいしので、Tagプロパティにも日付を格納するように
>CalUpdate を改良しました。これで後から日付を利用するときシンプルな
>コードになりますので。
ありがとうございます。.Tagプロパティに格納するという形だと理解しやすくなりました。
早速コードをコピーして実行してみましたら、
RS.FindFirst "出席日=#" & Split(.Tag, "#")(1) & "#"
のところで、「インデックスが有効範囲にありません」と表示されます。
前回のように
Private Sub Form_Load()
  SetCalendar Year(Date), Month(Date)
End Sub
の部分が消えているということはありません。

Debug.Print .Tag
を付け加えて実行してみましたら、ウィンドウに
2007/04/01
とだけ表示されています。

下記のすべてのsub、functionを記述すればよいのですよね?
Private Sub Form_Load()
Private Function Day_Click(D As Date)
Private Function SetCalendar(y As Integer, m As Integer)

Private Sub Form_Current()
Private Sub CalUpdate(y As Integer, m As Integer)
Private Sub SetColor(y As Integer, m As Integer)

下記の二つは中身が似ているのですが、functionとsubで違う使い方になっているということですね?
相互関係がわからなくなってきました。申し訳ありません。もう一度ご教示お願いいたします。
Private Function SetCalendar(y As Integer, m As Integer)
Private Sub CalUpdate(y As Integer, m As Integer)

【9677】Re:配列変数の引き渡し方
回答  hatena  - 07/7/9(月) 11:38 -

引用なし
パスワード
   >早速コードをコピーして実行してみましたら、
>RS.FindFirst "出席日=#" & Split(.Tag, "#")(1) & "#"
>のところで、「インデックスが有効範囲にありません」と表示されます。

Tagプロパティには日付がそのままは行ってますので、Splitで
取り出す必要は有りません。

RS.FindFirst "出席日=#" & .Tag & "#"

>下記のすべてのsub、functionを記述すればよいのですよね?
>Private Sub Form_Load()
>Private Function Day_Click(D As Date)
>Private Function SetCalendar(y As Integer, m As Integer)
>
>Private Sub Form_Current()
>Private Sub CalUpdate(y As Integer, m As Integer)
>Private Sub SetColor(y As Integer, m As Integer)

アップしたときに、こちらでサンプル用に作ったのとごっちゃになってました。

フォームに必要なコードは下記がすべてです。

Private Sub Form_Load()
  SetCalendar Year(Date), Month(Date)
End Sub

Private Sub Form_Current()
  SetColor Year(Date), Month(Date)
End Sub

Private Function Day_Click(D As Date)
  Screen.ActiveControl.Value = D
End Function

Private Sub SetCalendar(y As Integer, m As Integer)
Dim i As Integer, j As Integer, FirstDay As Date, s As Integer

  For j = -3 To 2
    FirstDay = DateSerial(y, m + j, 1)
    s = Weekday(FirstDay)
    For i = 0 To Day(DateSerial(y, m + j + 1, -1))
      With Me(Chr(Asc("d") + j) & i + s)
        .Caption = Day(FirstDay + i)
        .OnClick = "=Day_Click(#" & FirstDay + i & "#)"
        .Tag = FirstDay + i
      End With
    Next
  Next

End Sub

Private Sub SetColor(y As Integer, m As Integer)
Dim i As Integer, j As Integer
Dim db As DAO.Database
Dim RS As DAO.Recordset
Dim strSQL As String
  strSQL = "SELECT * FROM 出欠 " & _
      "WHERE 出席日 Between #" & DateSerial(y, m + 0, 1) & _
      "# AND #" & DateSerial(y, m + 2, 0) & "#"
  Set db = CurrentDb()
  Set RS = db.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
  
  For j = -3 To 2
    For i = 1 To 42
      With Me(Chr(Asc("d") + j) & i)
        If .Tag = "" Then
          .BackColor = vbWhite
        Else
          RS.FindFirst "出席日=#" & .Tag & "#"
          If RS.NoMatch Then
            If WeekdayName(Weekday(.Tag)) = Me.曜日 Then
              .BackColor = vbMagenta
            Else
              .BackColor = vbWhite
            End If
          ElseIf RS!出欠 Then
            .BackColor = vbBlue
          Else
            .BackColor = vbRed
          End If
        End If
      End With
    Next
  Next
  RS.Close
End Sub


まったく同じサンプルは作ってないので、
まだ、おかしなところがあるかも知れませんが、
たぶんこれでいいと思います。

【9682】Re:配列変数の引き渡し方
質問  メイ子  - 07/7/10(火) 14:20 -

引用なし
パスワード
   ▼hatena さん:
できました!!
大変丁寧に教えていただきありがとうございました。
素晴らしいシステムになりつつあり、喜んでおります。

ところで、もう一つだけ質問させてください。

  For j = -3 To 2
    For i = 1 To 42
      With Me(Chr(Asc("d") + j) & i)
        .Caption = ""
      End With
    Next
  Next

月が替わった時に、.Captionの数字が残るので、一旦消してからと思ったのですが、上記のコードを
Private Sub SetCalendar(y As Integer, m As Integer)
の直後に入れました。もっといい方法はありますか?
レスポンスはほとんど変わらないようです。

【9683】Re:配列変数の引き渡し方
回答  hatena  - 07/7/10(火) 14:40 -

引用なし
パスワード
   >月が替わった時に、.Captionの数字が残るので、一旦消してからと思ったのですが、上記のコードを
>Private Sub SetCalendar(y As Integer, m As Integer)
>の直後に入れました。もっといい方法はありますか?

えっと、直後でなくて、直前ですよね。

コード自体は私が書いてもそうような感じになります。

【9685】Re:配列変数の引き渡し方
質問  メイ子  - 07/7/10(火) 19:03 -

引用なし
パスワード
   ▼hatena さん:
ご教示ありがとうございます。

>えっと、直後でなくて、直前ですよね。
>コード自体は私が書いてもそうような感じになります。

下記の場所に入れました。直前とは、どこに入れることになりますか?
後、もう一つ難問ができてしまいました。
休日だけ文字の色を変える必要があると気がついたので、下記のようにしてみましたが、無反応です。「休日一覧」テーブルには「ID」と「休日」というフィールドがあり、「休日」は日付型です。
どこを直したらよろしいでしょうか?度々申し訳ありません。

Private Sub SetCalendar(y As Integer, m As Integer)

Dim i As Integer, j As Integer, FirstDay As Date, s As Integer

  For j = -3 To 2
    For i = 1 To 42
      With Me(Chr(Asc("d") + j) & i)
        .Caption = ""
      End With
    Next
  Next

Dim db As DAO.Database
Dim RS As DAO.Recordset
Dim strSQL As String
  strSQL = "SELECT * FROM 休日一覧 "
  Set db = CurrentDb()
  Set RS = db.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
  
  For j = -3 To 2
    FirstDay = DateSerial(y, m + j, 1)
    s = Weekday(FirstDay)
    For i = 0 To Day(DateSerial(y, m + j + 1, -1))
      With Me(Chr(Asc("d") + j) & i + s)
        RS.FindFirst "休日 = " & DateSerial(y, m + j, 1)
          If RS.NoMatch Then
            .Caption = Day(FirstDay + i)
            .OnClick = "=Day_Click(#" & FirstDay + i & "#)"
            .Tag = FirstDay + i
          Else
            .Caption = Day(FirstDay + i)
            .ForeColor = vbRed
            .OnClick = "=Day_Click(#" & FirstDay + i & "#)"
            .Tag = FirstDay + i
          End If
      End With
    Next
  Next

End Sub

【9689】Re:配列変数の引き渡し方
回答  hatena  - 07/7/11(水) 13:31 -

引用なし
パスワード
   >下記の場所に入れました。直前とは、どこに入れることになりますか?

意味を取り違えてました。現在の位置でいいです。

>後、もう一つ難問ができてしまいました。
>休日だけ文字の色を変える必要があると気がついたので、下記のようにしてみましたが、無反応です。「休日一覧」テーブルには「ID」と「休日」というフィールドがあり、「休日」は日付型です。
>どこを直したらよろしいでしょうか?度々申し訳ありません。

とりあえず下記のように修正してみてください。

>Private Sub SetCalendar(y As Integer, m As Integer)
>
>Dim i As Integer, j As Integer, FirstDay As Date, s As Integer
>
>  For j = -3 To 2
>    For i = 1 To 42
>      With Me(Chr(Asc("d") + j) & i)
>        .Caption = ""
        .OnClick = ""
        .ForeColor = vbBlack
>      End With
>    Next
>  Next
>
>Dim db As DAO.Database
>Dim RS As DAO.Recordset
>Dim strSQL As String
>  strSQL = "SELECT * FROM 休日一覧 "
>  Set db = CurrentDb()
>  Set RS = db.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
>  
>  For j = -3 To 2
>    FirstDay = DateSerial(y, m + j, 1)
>    s = Weekday(FirstDay)
>    For i = 0 To Day(DateSerial(y, m + j + 1, -1))
>      With Me(Chr(Asc("d") + j) & i + s)
        RS.FindFirst "休日 = #" & FirstDay + i & "#"
        If Not RS.NoMatch Then
          .ForeColor = vbRed
        End If
        .Caption = Day(FirstDay + i)
        .OnClick = "=Day_Click(#" & FirstDay + i & "#)"
        .Tag = FirstDay + i
>      End With
>    Next
>  Next
>
>End Sub

【9691】Re:配列変数の引き渡し方
お礼  メイ子  - 07/7/11(水) 14:01 -

引用なし
パスワード
   ▼hatena さん:
できました!
大変丁寧に教えていただき、また何度もお付き合い頂き、ありがとうございました。
高度ですが、とても簡潔なコードでわかりやすかったです。
私も、このようなコーディングを勉強して身に付けたいと思います。
またわからないことがありましたら、どうぞよろしくお願いいたします。

【9703】Re:配列変数の引き渡し方
質問  メイ子  - 07/7/21(土) 12:23 -

引用なし
パスワード
   ▼hatena さん

度々誠に申し訳ありません。機能追加をすることにしました。
下記のコードに加えて、「出席日」だけでなく、「振替出席日」にも色変更を加えようと思います。いろいろやってみましたが、複数条件がある場合、最初の条件分岐のところではelseifにしないといけないと思い、
Elseif RS.FindFirst "出席日=#" & .Tag & "#")(1) & "#"
とすると構文エラーになります。

RS.FindFirst "振替出席日=#" & .Tag & "#")(1) & "#"
をあちこちの場所に入れ替えて試してみましたが、上手く行きません。
どこを変えたらよいでしょうか?
「振替出席日」のフィールドは「出席日」と同じ「出欠」テーブルの中にあります。

後、フォームの詳細欄に.onclickで日付入力をしたいのですが、フィールドが日付型でない場合には、エラー表示をしようと思い、フィールドの型を取得する方法をあちこち探してみましたが、わかりませんでした。
ご教示よろしくお願いいたします。


>Private Sub SetColor(y As Integer, m As Integer)
>Dim i As Integer, j As Integer
>Dim db As DAO.Database
>Dim RS As DAO.Recordset
>Dim strSQL As String
>  strSQL = "SELECT * FROM 出欠 " & _
>      "WHERE 生徒番号=" & Me.生徒番号 & " AND " & _
>      "出席日 Between #" & DateSerial(y, m + 0, 1) & _
>      "# AND #" & DateSerial(y, m + 2, 0) & "#"
>  Set db = CurrentDb()
>  Set RS = db.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
>  
>  For j = -3 To 2
>    For i = 1 To 42
>      With Me(Chr(Asc("d") + j) & i)
>        If .OnClick= "" Then
>          .BackColor = vbWhite
         Elseif RS.FindFirst "出席日=#" & .Tag & "#")(1) & "#" ←
>          If RS.NoMatch Then
>            If WeekdayName(Weekday(.Tag)) = Me.曜日 Then
>              .BackColor = vbMagenta
>            Else
>              .BackColor = vbWhite
>            End If
>          ElseIf RS!出欠 Then
>            .BackColor = vbBlue
>          Else
>            .BackColor = vbRed
>          End If
>        End If
>      End With
>    Next
>  Next
>  RS.Close
>End Sub

【9704】Re:配列変数の引き渡し方
回答  hatena  - 07/7/21(土) 22:20 -

引用なし
パスワード
   >下記のコードに加えて、「出席日」だけでなく、「振替出席日」にも色変更を加えようと思います。

「振替出席日」情報はテーブルにはどのような形で格納されているのでしょうか。

【9705】Re:配列変数の引き渡し方
質問  メイ子  - 07/7/23(月) 12:01 -

引用なし
パスワード
   ▼hatena さん:
ご回答ありがとうございます。何度もすみません。

>「振替出席日」情報はテーブルにはどのような形で格納されているのでしょうか。

「出席日」と同じく日付型で、「出欠」にチェックが入っていない場合(出席日に欠席した場合)に、「振替出席日」に日付を.onclickで入力する形になります。
よろしくお願いいたします。

【9706】Re:配列変数の引き渡し方
回答  hatena  - 07/7/23(月) 15:31 -

引用なし
パスワード
   >「出席日」と同じく日付型で、「出欠」にチェックが入っていない場合(出席日に欠席した場合)に、「振替出席日」に日付を.onclickで入力する形になります。
>よろしくお願いいたします。

出席日 とは別の 日付 が入っていると言うことですね。
ならば、別に検索して見つかれば、色を変更するコードを追加すれば
いいのではないでしょうか。

Private Sub SetColor(y As Integer, m As Integer)
Dim i As Integer, j As Integer
Dim db As DAO.Database
Dim RS As DAO.Recordset
Dim strSQL As String
  strSQL = "SELECT * FROM 出欠 " & _
      "WHERE 出席日 Between #" & DateSerial(y, m + 0, 1) & _
      "# AND #" & DateSerial(y, m + 2, 0) & "#"
  Set db = CurrentDb()
  Set RS = db.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
  
  For j = -3 To 2
    For i = 1 To 42
      With Me(Chr(Asc("d") + j) & i)
        If .Tag = "" Then
          .BackColor = vbWhite
        Else
          RS.FindFirst "出席日=#" & .Tag & "#"
          If RS.NoMatch Then
            If WeekdayName(Weekday(.Tag)) = Me.曜日 Then
              .BackColor = vbMagenta
            Else
              .BackColor = vbWhite
            End If
          ElseIf RS!出欠 Then
            .BackColor = vbBlue
          Else
            .BackColor = vbRed
          End If
'-------------------追加
          RS.FindFirst "振替出席日=#" & .Tag & "#"
          If Not RS.NoMatch Then
            .BackColor = 65408 'お好みの色番号に
          End If
'--------------------
        End If
      End With
    Next
  Next
  RS.Close
End Sub

【9708】Re:配列変数の引き渡し方
質問  メイ子  - 07/7/25(水) 15:10 -

引用なし
パスワード
   ▼hatena さん:

>出席日 とは別の 日付 が入っていると言うことですね。
>ならば、別に検索して見つかれば、色を変更するコードを追加すれば
>いいのではないでしょうか。

ご教示ありがとうございます。同じelseの下に並列で書けばいいのですね。
大変勉強になりました。

後、もう一点お願いできますでしょうか?
フォームの詳細欄に.onclickで日付入力をしたいのですが、フィールドが日付型でない場合には、エラー表示をしようと思い、フィールドの型を取得する方法をあちこち探してみましたが、わかりませんでした。
度々申し訳ありませんが、ご教示よろしくお願いいたします。

【9709】Re:配列変数の引き渡し方
回答  hatena  - 07/7/26(木) 9:51 -

引用なし
パスワード
   >後、もう一点お願いできますでしょうか?
>フォームの詳細欄に.onclickで日付入力をしたいのですが、フィールドが日付型でない場合には、エラー表示をしようと思い、フィールドの型を取得する方法をあちこち探してみましたが、わかりませんでした。

フォームの Recorsetプロパティから、レコードセットを取得して、
フィールドのTypeプロパティで取得できますが、
サブフォームまで、考慮すると結構面倒なコードになりそうです。

日付型と連結しているテキストボックスの Tag プロパティに
目印を入れておくのがいいのでは。

【9712】Re:配列変数の引き渡し方
お礼  メイ子  - 07/7/26(木) 18:20 -

引用なし
パスワード
   ▼hatena さん:
>フォームの Recorsetプロパティから、レコードセットを取得して、
>フィールドのTypeプロパティで取得できますが、
>サブフォームまで、考慮すると結構面倒なコードになりそうです。
>
>日付型と連結しているテキストボックスの Tag プロパティに
>目印を入れておくのがいいのでは。

できました!ありがとうございました。
Tagプロパティはとても便利に使えるのですね。
丁寧にいろいろお教え頂き大変助かりました。
またわからないことがありましたら、どうぞよろしくお願いいたします。

876 / 2272 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
1078201
(SS)C-BOARD v3.8 is Free