Dim TM_COUNT() As Integer
Dim TM_NAME() As String
Set qry = db.CreateQueryDef("")
qry.SQL = TM_DATA()
Set REC = qry.OpenRecordset
ReDim TM_COUNT(1 to REC.RecordCount)
ReDim TM_NAME(1 to REC.RecordCount)
'以下略
Function TM_DATA()
TM_DATA = "SELECT T.[部門], Count(T.[部門]) AS 件数 FROM TEIKEN AS T"
TM_DATA = TM_DATA & " WHERE (((Format([次回],'yyyy/mm'))=Format(Now(),'yyyy/mm'))) GROUP BY T.[部門] HAVING (((T.[部門]) Is Not Null));"
Private Sub cmdSave_Click()
Me.BeforeUpdate = ""
DoCmd.RunCommand acCmdSaveRecord
Me.BeforeUpdate = "[イベント プロシージャ]"
End Sub
Private Sub cmdUndo_Click()
If Me.Dirty Then
Me.Undo
End If
End Sub
Private Sub Form_AfterUpdate()
Call InitTextbox
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
Cancel = True
End Sub
Private Sub Form_Undo(Cancel As Integer)
Call InitTextbox
End Sub
Public Sub InitTextbox()
'テキストボックス初期化
Dim CtlObj As Control
For Each CtlObj In Me.Controls
If CtlObj.ControlType = acTextBox Then
CtlObj.BorderColor = RGB(89, 89, 89) '普段は'
CtlObj.BorderWidth = 1 '黒細線'
End If
Next
End Sub
'テキストボックスの更新後処理に設定する関数
Private Function Textbox_Update()
With Me.ActiveControl
If Nz(.Value) = Nz(.OldValue) Then
.BorderColor = RGB(89, 89, 89) '普段は'
.BorderWidth = 1 '黒細線'
Else
.BorderColor = RGB(255, 0, 0) 'データ変更時は'
.BorderWidth = 2 '赤太線'
End If
End With
End Function
Option Compare Database
Option Explicit
Dim ctl As Control
'FirstDay As Date この行を削除して、下記の1行を追加
Dim FirstDay As Variant
Dim vDate As Date
さらに、SetCalendar関数の先頭部分を下記のように修正してください。
'カレンダー 日にち設定関数
Private Function SetCalendar(aDate As Date)
Dim i As Integer, D As Date, m As Integer, n As Integer
' If FirstDay > 0 Then この行を削除して、下記の1行を追加
If Not IsEmpty(FirstDay) Then
Me("D" & vDate - FirstDay).BackStyle = 0 '透明
End If
'以下略
'前略
If Not IsNull(DLookup("CLN_YMD","D_カレンダー","CLN_YMD=#" & txtyear & "/1/1" & #)) Then
MsgBox "既に入力済みの年です。別の年を指定してください。"
txtYear.SetFocus
Exit Sub
End If
'後略
Option Compare Database
Option Explicit
Private Sub datain_Click()
If IsNumeric(txtYear) = False Then
MsgBox "未入力もしくは数値以外が入力されてます。"
txtYear.SetFocus
Exit Sub
End If
If Abs(Year(Date) - txtYear) > 100 Then
MsgBox "年の指定が誤りです。"
txtYear.SetFocus
Exit Sub
End If
If IsNull(DLookup("CLN_YMD", "D_カレンダー", "CLN_YMD=#" & txtYear & "/1/1#")) Then
MsgBox "既に入力済みの年です。別の年を指定してください。"
txtYear.SetFocus
Exit Sub
End If
Dim dbs As Database
Dim rst As Recordset
Dim dtmLoop As Date
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("D_カレンダー")
With rst
For dtmLoop = CDate(Me.txtYear & "/1/1") To CDate(Me.txtYear & "/12/31")
.AddNew
!CLN_YMD = dtmLoop
!CLN_YOUBI = Format$(dtmLoop, "aaa")
!CLN_OFF = DLookup("HLD_NAME", "T_休日", "HLD_YMD=#" & dtmLoop & "#") '追加
!CLN_Y = dtmLoop
.Update
Next dtmLoop
.Close
Me.txtYear.Value = Null
End With
MsgBox "カレンダーが作成されました。"
DoCmd.Close
End Sub
Private Sub datadel_Click()
If MsgBox("データ削除しますか？", vbYesNo + vbQuestion) = vbNo Then Exit Sub
CurrentDb.Execute "DELETE * from D_カレンダー"
MsgBox "データが削除されました。"
End Sub
Private Sub datain_Click()
If IsNumeric(txtYear) = False Then
MsgBox "未入力もしくは数値以外が入力されてます。"
txtYear.SetFocus
Exit Sub
End If
If Abs(Year(Date) - txtYear) > 100 Then
MsgBox "年の指定が誤りです。"
txtYear.SetFocus
Exit Sub
End If
If IsNull(DLookup("CLN_YMD","D_カレンダー","CLN_YMD=#" & txtyear & "/1/1" & #)) Then
MsgBox "既に入力済みの年です。別の年を指定してください。"
txtYear.SetFocus
Exit Sub
End If
'以下略
.ControlTipText = Nz(DLookup("摘要","T_休日","日付=#" & D & "#"),"") '定休日をヒントテキストに設定
If .ControlTipText = "" Then
.ControlTipText = ktHolidayName(D) '祝日名をヒントテキストに設定
End if
hatena様
お世話になります。
解決しました！
Dim TM_COUNT(20) As Integer
Dim TM_NAME(20) As String
の意味を理解せず使用していました。
これを機会に良い勉強ができました。
ありがとうございました。
配列の要素数が20なので、当然そうなりますね。
動的配列で宣言しておいて、レコード件数を取得してからReDimで要素数を設定しましょう。
動的配列については下記を参照してください。
Office TANAKA - 変数の使い方[部屋数を変えられる動的配列]
hatena様
お世話になります。
以下でよろしいでしょうか？
Dim TM_COUNT(20) As Integer
Dim TM_NAME(20) As String
TM_COUNT(i)TM_NAME(i)というのは配列だと思いますが、これの宣言部分のコードも提示してもらえますか。hatena様
ご回答ありがとうございます。
TM_DATA() の中身は以下の通りです。
Function TM_DATA()
TM_DATA = "SELECT T.[部門], Count(T.[部門]) AS 件数 FROM TEIKEN AS T"
TM_DATA = TM_DATA & " WHERE (((Format([次回],'yyyy/mm'))=Format(Now(),'yyyy/mm'))) GROUP BY T.[部門] HAVING (((T.[部門]) Is Not Null));"
End Function
以上、よろしくお願い致します。
TM_DATA() というのは自作関数ですか。
qry.SQL にはどのようなSQL文がセットされていますか。
考えられる原因としては、上記のSQLに「件数」というフィールドがないということです。
hirotonさん hatenaさんありがとうございました。
おかげさまで解決することができました。hatenaさんの回答でいけました。
まだ初心者ですが、また頑張ることができそうです。
ありがとうございます！希望通りの動きになりました！
Form_BeforeUpdate(Cancel As Integer) で Cancel = True としているので
更新後処理も使えないものだと思っていました。
TXTBOXの数も多く、1つ1つ設定するのもアレでしたし、
今回の物では標準モジュールも使わなくて済み、わかりやすいプログラムで助かりました！
ありがとうございます。😃
下記のような感じでどうでしょうか。
変更の確定コマンドボタン
名前 cmdSave
取消コマンドボタン
名前 cmdUndo
フォームモジュール
フォームのデザインビューで、入力用のテキストボックスをすべて選択して、
「更新後処理」プロパティに
=Textbox_Update()と設定。hiroton さん
ありがとうございます。
変更の確定・取消ボタンおよび、レコード移動ボタンや、フォームを閉じるボタン等のクリック時イベントに、MsgBoxでデータが変更されている旨を表示するようにはしていますが、ドコソコのデータが変更されてるヨ。とは表示していません(僕のスキル的にまだできていません)。
入力フォームといっても、閲覧だけするユーザーも開く「閲覧入力兼用フォーム」であるので、閲覧ユーザーが誤ってデータを書き換えてしまったとき用に、どこのデータが書き換わっちゃってるのか、を明示したかったのです。
（データ変更されてるとき、レコード移動やフォームを閉じようとした際、確定または取消を押下しないとレコード移動等ができないようにしています）
レコード移動時などにMSGBOXで「●●TXTBOXが書き換わってます」とメッセージを出すより、視覚的にどこのデータが変更されてるか、わかりやすい方が良いと判断しまして、今回の質問に至りました。(フォームを使う人の中にはACCESSに明るくなかったり、年配の方も多いので)
よくわからないんですが、その入力・更新用テキストボックスの更新後処理や、変更の確定ボタン、取り消しボタンのクリック時に実行するんじゃダメなんですか？
クエリて、本日の日付を基準に、満了日を自動計算したいということなら、クエリに下記のような演算フィールドを追加してください。
式の意味が分かりやすいように３つに分割しましたが、一つにまとめることもできます。
計算式をどうにかすればいいのであれば
IIf([自動更新]=0,"---",DateAdd("yyyy",[自動更新],[契約日]-1))
↓
IIf([自動更新]=0,"---",DateAdd("yyyy",[自動更新],Nz([満了日],[契約日]-1)+1)-1)
でどうかな？
丁寧な解説ありがとうございます！
Date型や、variant型を特によく理解せずに使ってたので、すごく助かりました！😆
また、躓きましたら、助けを求めるかもしれません。
その時はよろしくお願いいたします！
まず、FirstDay変数には、カレンダーの先頭の日付の一つ前の日付か格納されます。
1900年1月のカレンダーだと、1/1は月曜なので、その前日の日曜は、1899/12/31 になりこれが先頭になります。
FirstDayには、1899/12/30 が格納されます。
修正前の
のコードの意味は、FirstDay に日付が代入されているかどうかをチェックしています。
つまり、カレンダーフォーム起動直後で、まだ、FirstDayに何も代入されていない場合はなにもせずに、
日付が代入されていたら選択日付のラベルの背景色を透明に戻す、
という処理をしています。
VBAの Date型の初期値（宣言してから何も代入されていないときの値）は #1899/12/30# でこれは内部的には 0 です。FirstDay > 0 でなければ、FirstDayは初期値のままでフォーム起動直後と判断していました。
ところが、1900年1月のカレンダーだと FirstDay には、1899/12/30 が代入されてしまいます。つまり、初期値と同じ値になります。このため、カレンダーの先頭日付か代入されているのに、初期値のままと判断してなにもしないことになり、後の処理で矛盾が発生してしまい動作がおかしくなりました。
修正後は、
FirstDay は Variant型で宣言しました。Variant型は初期値（代入前）は Empty値という特殊な値になります。また、どのようなデータ型でも代入できます。もちろんDate型の値も代入できます。IsEmpty関数でEmpty値かどうか判定できます。IsEmpty(FirstDay) が True なら確実に、初期値のまま（代入されていない）という判定ができます。
ありがとうございます！解決しました！
後学のためにお聞きしたいのですが、今回の事象の理由は以下の通りであってますでしょうか？
●変更前
・DATEデータ型の場合、1900/01/01が「0」、それ以前が負の数 で設定される。
・If FirstDay > 0 Then 部分で、1900/01/01以前の日がはじかれ、IF節内に入れなかった。
・1900/01/15などの日も、同カレンダー内に「0」が存在してしまっている為(？)に同様の事象。
●変更後
・型をVariantに変更し、IF条件をFirstDayが初期化されてたら(空っぽだったら?)ので、IF内の透明化処理(?)が行われた。
そのような昔の日付が入力されることは想定外でした。F_calendarフォームのモジュールで、
先頭の宣言部を下記のように修正してください。
さらに、SetCalendar関数の先頭部分を下記のように修正してください。
異常で問題なく動作するようになります。
hatenaさん
回答ありがとうございます。
ラベルの「〇」で対応させていただきます。
accessは便利なのでフォームでも図形処理の機能を増やすか
ActiveXでエクセルの図形機能を外部参照できれば便利になるのですが
今後のバージョンアップのときに組み込まれることを期待します。
本日はありがとうございました。
無事できました。
ありがとうございました。
最初の回答のコードが間違ってました。下記に修正してください。(Notが不足していた。)
添付しました画像の通りです。
一度既にあるデータを削除して年の値を入力すると、既に入力された数値ですと表示され、その後どの年数も受け付けなくなりました。
すみませんがよろしくお願いいたします。
D_カレンダー テーブルの各フィールド名、データ型、主キー設定を提示してください。
'''sql
の部分ですが、単引用符(')ではなくバッククォート(`)を３つ続けるとコードブロックになります。
バッククォートは Shift + @ で入力できます。
早速の回答ありがとうございます。
今度は実行時エラー’3022’が表示されました。
デバックをすると以下の箇所が黄色で示されました。
'''sql
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("D_カレンダー")
With rst
For dtmLoop = CDate(Me.txtYear & "/1/1") To CDate(Me.txtYear & "/12/31")
.AddNew
!CLN_YMD = dtmLoop
!CLN_YOUBI = Format$(dtmLoop, "aaa")
!CLN_OFF = DLookup("HLD_NAME", "T_休日", "HLD_YMD=#" & dtmLoop & "#") '追加
.Update
Next dtmLoop
.Close
Me.txtYear.Value = Null
End With
MsgBox "カレンダーが作成されました。"
DoCmd.Close
End Sub
'''
フォーム上ではcircleメソッドは使えませんね。
私の場合は、小さい円なら、ラベルの標題に「〇」を設定して使います。大きい円や楕円の場合は、エクセルかワードのオートシェイプで作成した図形を貼り付けてます。
あっ、すみません。コード間違ってますね。下記に修正してください。
ご回答ありがとうございます。
試したところ構文エラーが表示されます。
入力した段階で
'''sql
If IsNull(DLookup("CLN_YMD","D_カレンダー","CLN_YMD=#" & txtyear & "/1/1" & #)) Then
'''
が赤文字になります。
カレンダーテーブルに認識用に"CLN_Y"を作成して試してみましたが、エラーが表示されます。
下記でどうでしょうか。
はい、それでもいいと思います。
結果は同じですのて、仕様に合わせて選択すればいいでしょう。
今回の場合は、エクセルでの画像をみると日付の上に罫線があるので、日付ヘッダーは表示させて直線コントロールを配置するといいかなと思い、そちらを提案しました。
最後のところ、VBAは使わずに
「日付グループヘッダー」
可視：いいえ
「日付」テキストボックスと「注意事項」テキストボックスは「詳細セクション」に配置
重複データ非表示：はい
でいいんでないかな。と
サブフォームのレコードソースのテーブルに「年」フィールドがあるということでしょうか。
もう少し、具体的かつ詳細な情報が必要です。その内容では状況が分かりません。
また、別の質問になると思いますので、新規に質問しなおしてください。
そのときに、具体的かつ詳細な情報を提示してください。
再度すみません、サブフォームの年に同じ値を入れて作成すると重複のエラーが表示されるので、こちらをメッセージを出るようにしてるのですが、どうにも上手くいきません。
色々調べて入力規則を使う方法を試しましたが、別なエラーが表示されてしまい、上手く作動せず。
クエリを使用して行う方法は、設定が理解できず挫折しました。
VBAで組んでみたのは、すべての数値を弾くものになりました。
カレンダーテーブルに年だけのフィールドを作成して、それと入力フォームを比べて重複を確認しようとしましたが、IF関数で組みました上手くいきません。
申し訳ございませんが、よろしくお願いいたします。4
詳しい解説ありがとうございました
とても参考になりました
ありがとうございます。
If文で切り分けるといいでしょう。
度々申し訳ございません。
祝日のマクロとの併用はやはり難しいのでしょうか？
先の説明で不足していたのですが、祝日は休みが基本なので自動で入力できるとありがたいのですが。
無事に動きましたありがとうございます。
単純なミスでした。
申し訳ございませんでした。
コードを下記に修正したらどうでしょうか。
早速のレスありがとうございます。
一応一度は成功したのですが、再度カレンダーフォームを起動すると「実行時エラー’13’ 型が一致しません。」とエラーが発生します。
デバック箇所は、
になります。
カレンダーは基本操作画面フォームがあり、カレンダーボタンをクリックすると現在のカレンダーと年を入力・作成するサブフォームが開くようになっていますが、開かなくなりました。
この場合の対処も教えてくださますでしょうか？
申し訳ございませんが、よろしくお願いいたします。