Option Compare Database
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32.dll" ()
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Const HTBOTTOMRIGHT = 17
Private Sub lblResize_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And acLeftButton Then
ReleaseCapture
Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0&)
End If
End Sub
Private Sub 詳細_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And acLeftButton Then
ReleaseCapture
Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
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文は必要ないですね。
フォームを開くアクションのあとに、「メッセージボックス」を追加するだけです。
あっ、ごめなさい。アップロードするフォルダーを間違えてました。今、移動させましたので、ダウンロードできるはずです。ご確認ください。
最初、拡張ズームボックス関数 - hatena chipsを参考に、API の SetWindowLong で何とかしようと苦戦しましたが、うまくいきませんでした。
ふと、下記を思い出して、
タイトルバー以外をドラッグしてフォームを移動させる - hatena chips
これを参考にSendMessageで右下枠をクリックしたことにすればうまくいきました。
フォームの右下にラベルを配置して、下記のように設定します。
名前 lblResize
水平アンカー 右
垂直アンカー 下
フォームのモジュールを下記のように記述します。
以上です。ラベルを使用しましたが、四角形コントロールやイメージコントロールでもOKです。
右下以外でもサイズ変更したい場合は、下記を参考にConst宣言してください。
HTLEFT 10 可変枠の左辺境界線
HTRIGHT 11 可変枠の右辺境界線
HTTOP 12 可変枠の上辺境界線
HTTOPLEFT 13 可変枠の左上隅
HTTOPRIGHT 14 可変枠の右上隅
HTBOTTOM 15 可変枠の下辺境界線
HTBOTTOMLEFT 16 可変枠の左下隅
HTBOTTOMRIGHT 17 可変枠の右下隅
ちなみに、下記を追加すると詳細セクションのドラッグでフォームを移動できます。
ありがとうございます！！早速ダウンロードを試みましたが、「404 File Not Found」となりました。
もう削除されてしまったでしょうか…遅くなり申し訳ありません。
漠然とした質問についてご回答頂きありがとうございます、試して確認する事ができました。
ただ、１レコード毎に処理しているのでしょうか、処理時間がかかりました。
Between を使いながら選択クエリで同様の事を実現できたので、追加クエリと組み合わせて処理しようと思います。
もやっとした説明ですが、下記のようなことでしょうか。
TBL1
TBL1
サブフォームのヘッダーかフッターにテキストボックスを配置してコントロールソースを下記のように設定します。
=Sum([数量]*[仕切値])
これでサブフォームに表示されているレコードの集計値(＝整理番号毎の集計値)が表示されます。
このテキストボックスの名前を「金額計」とします。
メインフォームにテキストボックスを配置してコントロールソースを下記のように設定します。
=[サブフォームコントロール名].Form![金額計]
サブフォームコントロール名については下記を参照してください。
サブフォームとサブフォームコントロールの違いとは？ - hatena chips
こちらからはそちらのファイルは見れないので、まずは、関連する現状のテーブル名、フィールド名、主キーフィールドの設定を提示してもらえませんか。
あるいは、右カラムの下のほうの「ファイル送信フォーム」から現状のファイルを送信してください。
主キーテーブルにな納税通知書番号しか入れていないのですが、それが理由でしょうか？
hatenaさんがおっしゃった通り,通知書番号、氏名、郵便番号、住所を格納したテーブルを作成し、それぞれ各フィールドにデータを指定し、リレーションシップで繋げたのですが、参照適合性が一致しないとの事でした。
通知書番号、住所、名前、郵便番号 を格納したテーブルが必要になります。
あるいは、住所、名前、郵便番号 を格納したテーブルと、通知書番号を格納したテーブルと、それらを関連付けるテーブルが必要です。
現状、どのようなテーブルがありますか。
ありがとうございました。
編集言語、作成言語(言語パックインストール)を英語にしてから開発することで、海外でも使えるようになったようです。
同じような時期に同様の事象にとても苦労しましたので参考にしてください。
結果を先に書くと Window10のUPDATEの影響で共有方法が変わってしまったようでした。
利用環境は、access2010で作成したaccdbを access2016で使用しています。
データ部だけをサーバに置き10人程度で参照、追加、更新等を同時に実施しています。
データ部へのアクセスにレコードロックはかけていません（まれにDirtyとなることもあります）
ある日、ACCESSの設定変更していないのに突然サーバにあるＤＢに接続できなくなりました。
まったく原因がわからず、ネットで数日間調べていました。
その間もＤＢ障害が発生し、その都度最適化をしていました。
やっと１件だけ同じ現象を解消したとの記事があり、適応してみました。
内容は 「暗号化方法の設定」を変更しました。
ACCESS→ ファイル→ オプション→ クライアントの設定→ 規定の暗号化方法使用する（高度なセキュリティ）
規定の暗号化方法使用する（高度なセキュリティ） → 以前の暗号方法を使用する にしました。
これにより以前と同様使用できるようになりました。
適宜、オプションの中身を確認するようにしています。
最近も「クライアント設定」を確認したところ「レコードレベルでロックして開く」
にチェックが入っていました。こんなチェックは付けた覚えがありません。
これも全端末の設定を外しています。
これかな？
Office で編集言語または作成言語を追加する、または言語設定を行う
あと、自分の環境では英語はインストール済みでしたが
Office の言語アクセサリ パック
※試していません
ありがとうございます。
ご指摘通り、消し忘れでした。
CSVファイルなどのテキストファイルをインポートするときはインポート定義を設定できますが、エクセルファイルをインポートにはインポート定義はないです。
「保存済みのインポート操作」のことを言っているのなら、その画面で、ファイル名のところをクリックすれば編集できます。
Access2019で確認しましたが、下記のリンク先によると2007でもできるようです。
ACCESS 2007 で、保存済みのインポート操作を編集したいのですが、どうす... - Yahoo!知恵袋
問題なと思います。
ただ、下記の変数宣言は、使ってないので不要でしょう。
Dim strSQL As String一応こんなのでできましたが、問題はないでしょうか。
Dim strSQL As String
Dim rst As DAO.Recordset
Set rst = Me.subForm.Form.RecordsetClone
rst.MoveFirst
Do Until rst.EOF
rst.Edit
rst.Fields(checkItem) = True
rst.Update
rst.MoveNext
Loop
Me.subForm.Form.Requery
hatanaさん
ご回答ありがとうございます。
なるほど、気づきませんでした。
連続した番号のフィールドを作って、こちらを使わせていただきます。
下記のSQLで可能です。
ただし、オートナンバー型の場合、削除したものは再利用されないので、番号が連続している保証はないので注意が必要です。連続した連番が必要なら、オートナンバー型とは別に連番用のフィールドを用意したほうかいいでしょう。
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でエクセルの図形機能を外部参照できれば便利になるのですが
今後のバージョンアップのときに組み込まれることを期待します。
本日はありがとうございました。
無事できました。
ありがとうございました。