Option Compare Database
Option Explicit
Declare PtrSafe Function GetScrollInfo Lib "user32" (ByVal hwnd As LongPtr, ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long
#If Win64 Then
Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Const GWL_STYLE = (-16)
' Window Style Flags
Private Const WS_VISIBLE = &H10000000
Private Const WS_VSCROLL = &H200000
' Scroll Bar Styles
Private Const SBS_HORZ = &H0&
Private Const SBS_VERT = &H1&
Private Const SBS_SIZEBOX = &H8&
' ScrollInfo fMask's
Private Const SIF_RANGE = &H1
Private Const SIF_PAGE = &H2
Private Const SIF_POS = &H4
Private Const SIF_DISABLENOSCROLL = &H8
Private Const SIF_TRACKPOS = &H10
Private Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS Or SIF_TRACKPOS)
' Scroll Bar Constants
Private Const SB_HORZ = 0
Private Const SB_CTL = 2
Private Const SB_VERT = 1
' Windows Message Constant
Private Const WM_VSCROLL = &H115
Private Const WM_HSCROLL = &H114
' GetWindow() Constants
Private Const GW_HWNDNEXT = 2
'Private Const GW_HWNDPREV = 3
'Private Const GW_OWNER = 4
Private Const GW_CHILD = 5
'Private Const GW_MAX = 5
Private Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type
Public Function fGetScrollBarPos(frm As Form) As Long
Dim lngret As Long
Dim sInfo As SCROLLINFO
sInfo.fMask = SIF_ALL
sInfo.cbSize = Len(sInfo)
sInfo.nPos = 0
sInfo.nTrackPos = 0
Dim hWndSB As LongPtr
hWndSB = fIsScrollBar(frm)
lngret = GetScrollInfo(hWndSB, SB_CTL, sInfo)
fGetScrollBarPos = sInfo.nPos + 1
End Function
Public Function fIsScrollBar(frm As Form) As LongPtr
Dim hWnd_VSB As LongPtr
Dim hwnd As LongPtr
hwnd = frm.hwnd
hWnd_VSB = GetWindow(hwnd, GW_CHILD)
Do
Select Case fGetClassName(hWnd_VSB)
Case "scrollBar", "NUIScrollBar"
If GetWindowLongPtr(hWnd_VSB, GWL_STYLE) And SBS_VERT Then
fIsScrollBar = hWnd_VSB
Exit Function
End If
End Select
hWnd_VSB = GetWindow(hWnd_VSB, GW_HWNDNEXT)
Loop While hWnd_VSB <> 0
fIsScrollBar = -1
End Function
Private Function fGetClassName(hwnd As LongPtr)
Dim strBuffer As String
Dim lngLen As Long
Const MAX_LEN = 255
strBuffer = Space$(MAX_LEN)
lngLen = GetClassName(hwnd, strBuffer, MAX_LEN)
If lngLen > 0 Then fGetClassName = Left$(strBuffer, lngLen)
End Function
フォーム上にコマンドボタンを配置して、下記で表示されるようです。
Private Sub コマンド1_Click()
MsgBox "レコード: " & fGetScrollBarPos(Me) & "/" & Me.Recordset.RecordCount
End Sub
If myCtrl.Name Like "txt*" Then
If IsNull(myCtrl.Value) Or Len(myCtrl.Value = 0) Then
MsgBox "入力必須項目に入力漏れがあります"
入力漏れ = True
Exit Function
End If
End If
あるいは、Nz関数を使うと Null を適切に変換してくれますので、下記でもOKです。
If myCtrl.Name Like "txt*" Then
If Nz(myCtrl.Value) = "" Then
MsgBox "入力必須項目に入力漏れがあります"
入力漏れ = True
Exit Function
End If
End If
hatenaさんご返信、
どうもありがとうございました。
すごいシステムをサンプルまで
作ってくださって、ありがとうございます。
まさに私の欲しかったものです。
VBAを使うんですね。
かなり難しそうだけれど、
このサンプルを頑張って
研究しようと思います。
hiroton 様
ヒントをもとに検証したところ、どんなヘッダ高さ、詳細高さでも安定して先頭レコードを表示することができました！
リンク先のコードよりもシンプルかつ分かりやすいコードになったと思います。
こちらで問題ないでしょうか？？
hiroton 様
考察していただきありがとうございます。
hatena様のご回答により当初の目的は果たしたのですが、まだモヤモヤがぬぐい切れていないので私もhiroton様の考察をもとに検討させていただきます。
恥ずかしながらリンク先のコードは世に出回っているものなので必ず正であるという固定概念があり、小数点が出る計算に対して「なぜ」という考えに至りませんでした。
hiroton様のおっしゃる通り、求めたい値に対してなぜその計算をするのか理屈を考えながら進めていきたいと思います。
簡単なサンプルを作成してみましたので、よろしかったらご参考に。
下記をクリックするとファイルをダウンロードできます。
Sample747.zip
オプショングループ内にトグルボタンを配置して、それでサブフォームにフィルターをかけるという設計にしています。
オプショングループをタブコントロールに置き換えたサンプルもあります。
なんだか丸め誤差といえるほど小さな誤差じゃなさそうですね
ヘッダーと詳細セクションの間、詳細セクション同士（レコード同士）の間に高さがあるのかもしれません
後ほど検証してみようと思いますが、取り掛かりまでしばらくかかりそうです（hatenaさんが素晴らしい回答をされているので甘えます）
そもそも詳細セクションがいくつ並んでるかを求めるという話なので、詳細セクション合計の高さを詳細セクション個別の高さで割ればレコードの数になるはずです
CurrentSectionTopはフォーム上端からの高さを返すのでヘッダー分を引かなければなりませんが、「レコード分に換算して引く」という手法がよくわかりません。単純にCurrentSectionTopからヘッダー分の高さを引けば詳細セクション合計の高さが残るはずです計算式は
((ヘッダー + レコード数 * height) - ヘッダー) / heightとなり、そもそも小数点が出る計算がおかしいというのを焦点にしたかったんですが、結果は検証してみてですね沢山のご返答ありがとうございます。
折角ご返答いただいたのに、なかなか
お返事できなくてすみません。
サブフォームのデーターですが
以下のようになっております。
Qhp_アクセス集計
・アクセス集計ID
・サイト情報ID
・記録日
・UUカウント
・PVカウント
・アクセス集計登録日
後は、
●（今年の）今月
●全
●今年の1月～12
以上をタブに表示したいです。
Accessって難しいですね。
折角、ご返事いただいているのに、
頭がこんがらがって
どうお返事していいか
分かりませんでした。
hatena 様
ご返信ありがとうございます。
上記コードをそのまま試したところ、無事に動作確認が取れました。
わざわざ64bit対応で書いていただき、大変ありがとうございます。
正直コード内容については一読で理解できそうにないので、じっくり読まさせて頂きます。。
すみません、補足です。上記のように
の高さだと四捨五入 Int((curTop / Me.Section("詳細").Height)+0.5) をすれば成り立つのですが、
の高さだと四捨五入すると逆にずれ、どの場所でもそのままで成り立つという現象になり、なかなか安定せずに悩んでおりました。
Windows API を使う方法です。
標準モジュールに下記のコードをコピーしてください。
フォーム上にコマンドボタンを配置して、下記で表示されるようです。
Office2019 64bit で動作確認。
64bit対応に書き換える時間がなかなか取れなかったので回答が遅くなりました。
hiroton 様
色々とご説明いただきありがとうございます。
まだまだ勉強不足でございました。
１．「見た目」とツールチップは同じでVBAの結果にずれがある
に該当します。
ツールチップについてはACCESS外の話になるとのことので、また別で考えさせていただきます。
以下、リンク先のコードにそって情報提示致します。
うまくいく場合
ずれる場合
ご指摘どおり丸め処理がずれていると思います。
うまくいく場合 Int(3180 / 397) = 8.0100...=8 OK
ずれる場合 Int(3570 / 397) = 8.992...=8 （本当は9の値が欲しい）
どのように修正すればどんな条件でも一致するか悩んでおります。
スクロールバーをマウスでつかんだとき出てくるそれをツールチップと呼びますが、ずれとは以下のどのような状態でしょう？
１．「見た目」とツールチップは同じでVBAの結果にずれがある
２．「見た目」とVBAの結果は同じでツールチップにずれがある
（１）の場合コードに不備があるのだと思います（hirotonはリンク先のコードを検証していません）
（２）の場合はスクロールバーが何を基準に数字を出しているのかわからないのでCurrentSectionTopを使った方法では無理なのかもしれません
『「直接」は難しい』についてですが、出来る出来ないで言えば出来ると思います。質問のリンク先で言われているようなことを今の環境に合わせて実装すればいいです。「windows api」「スクロールバー」「ツールチップ」等のキーワードを組み合わせれば情報を得られるでしょう
ただ、キーワードを見てわかるようにほぼACCESSとは関係ない内容になるのでhirotonとしてはこの掲示板でどうこうするつもりはありません
これについて情報が欲しい場合は他の方の回答を待ってください
難しいことに手を出そうとしているようだったのでキーワード（Form.CurrentSectionTop）だけ出せばある程度作れる能力があるのかなと思っていましたが、そうでもなさそうですね
うまくいかないパターンのそれぞれのプロパティの値と実際に見えるレコードの番号、ツールチップの値を提示してください。このような計算において丸め処理（「Int()」や「/」での計算も）は繰り返せば繰り返すほど後々大きな誤差になります
この処理は、理屈を考えれば単純で、「積み上げた積み木を数えるようなもの」なので計算結果で小数点がでるというのが何かちょっと違うなぁと感じます（普通、積み木が3.998個重なっていますとはならない）
リンク先コードでは
という処理が合って、ここで丸め処理をしているので何か影響してる可能性があります。これが必要な処理なのか考えてみてください。（もしくは上述の通り情報提供してください）
hiroton 様
返信遅くなり申し訳ございません。
やはり難しいですか…承知しました。
たしかに上記の式でほぼ取得可能なのですが、場所によって１つずれる現象がございました。
私なりに調べたところ
の部分が原因らしく、
curTop / Me.Section("詳細").Height の値が「●●.998…」等になる場合、そのまま小数点が切り捨てられてしまい1つずれてしまいます。
ならば
で、四捨五入すれば良いかなと思ったのですが、そうすると今までOKだった箇所が1つずれたりと、うまく安定してくれません。
curTop / Me.Section("詳細").Height の値によってずれたりずれなかったりするため、単純にスクロールバーの整数の値を取得できれば確実だなと思い質問しました。
ただずれるとしてもひとつ程度なので、とりあえずはこれで運用していきたいと思います。
ご教授ありがとうございました。
ありがとうございました。
できました。
「Null または、空白の時、反応するコード」ということなので、Or条件になります。
あるいは、Nz関数を使うと Null を適切に変換してくれますので、下記でもOKです。
ありがとうございます！！
その形で進めようと思います。
まだ、更新クエリ、追加クエリをささっと作成できる技量がないので、勉強しながらやってみようと思います。
追加のアドバイスもありがとうございます。
また、行き詰まったらお邪魔するかもしれませんが頑張ってみます。
上の回答の追記の方法でどうでしょう。
更新クエリは、インポートしたテーブルとT_商品リストを「商品番号」で結合したクエリにするといいでしょう。
あるいは、下記のようにしてもいいでしょう。
エクセルのテーブルをAccessにインポートする。
更新クエリでインポートしたテーブルの「商品番号」を「商品ID」に変換する。
このテーブルを追加クエリで「T_在庫管理表」に追加する。
ご教示ありがとうございます。関係性をよく理解しておらず、おっしゃる通り商品リストを更新してしまったりでうまくいっていませんでした。
その場合は、Accessの商品リストをエクセルにエクスポートしてから利用するということであっていますか？
日々大量の商品をAccessのT_商品リストに登録していく事になるのでちょっと不安があるのですが、、、。
ご希望の処理の流れは下記になると思います。
バーコードスキャナアプリで「商品番号」を読み込む。CSVファイルとして保存される。
↓
エクセルファイルにテーブルとして読み込む。
↓
これをAccessのテーブルに取り込む。
「Q_在庫管理表」に取り込むという考え方ではなく「T_在庫管理表」にデータを取り込むという考え方にすべきでしょう。
「Q_在庫管理表」にコピペしたとしても、データが最終的に追加されるのは「T_在庫管理表」ですので。
「Q_在庫管理表」には「T_商品」などのマスターテーブルのフィールドも表示されていますが、これらのフィールドは更新してはだめなので。
「T_在庫管理表」には「商品番号」や「商品名」などのフィールドはないはずですので、外部キーである「商品ID」を入力する必要があります。
いったん、エクセルに落とし込むなら、エクセルの方で「商品番号」を「商品ID」に変換するのが簡単そうですが、それではだめでしょうか。
早速のお返事ありがとうございます。
Q_在庫管理表
現実にはこのようになっています。
見ようみまね作成しているので無駄な部分やおかしな所があるかもしれませんが、、。
F_在庫管理表フォームも作成してあり、通常はそちらから手作業で入力していたのですが、バーコードスキャナアプリのデータで入力できないかと思考錯誤している段階で、
複数の【品番】をアプリで読み取りcsv形式でパソコンに保存
↓
Q_在庫管理表と同じ形のEXCELのテーブルに落とし込み
↓
Q_在庫管理表に追加でコピペ
これでできないだろうかと思っての質問でした。
ごめんなさいどのようにすればいいのかわからないです。
よろしくお願いいたします。
Q_在庫管理表 のSQLを提示してもらえますか。
EXCEL と Access の連携はどのように考えているのでしょうか。
データをエクセルに格納するなら、エクセルで直接読み取ればいいと思いますが。
「直接」は難しいと思います
ただ、左の数字は
で取得可能。右の数字はレコード総数なので
とすれば同じ内容になると思いますが、これではまずいですか？
hiroton 様
大変申し訳ございません。上記の方法を不完全な状態で試しておりました。
（curTop = Me.CurrentSectionTop が抜けていました）
ちゃんとした方法で行ったところ、うまくいきました。
ちなみにスクロールバーの値はやはり取得するのは難しいものでしょうか…？
お世話になっております。上述のExitイベントで未入力に加えて、入力規則にのっとっているか判別（桁数のチェック）を行えるようにしました。
正しく動いているんですが、不正な状態のままレコードを削除したく、困っています。
フォーム上に削除ボタンを作り、 DoCmd.RunCommand acCmdDeleteRecord で削除していますが、不正な入力状態のまま削除ボタンを押すと、先に上述のEXITイベントが発動して、削除ボタンを受け付けてくれません。
回避方法を模索しているんですが、どうしてよいかわかりません。特定のイベントの時だけこのEXITイベントをキャンセルする、というようなテクニックはないでしょうか？
hiroton 様
度々のご返信ありがとうございます。
ただ申し訳ございません、求めているものとは少し違っておりました。
上記の方法で試したところ、たしかにレコードは同じ位置になるのですが、表示位置が一番上にきてしまいます。
スクロールバーの値さえ取得すれば、GoToPageを使用して実行後も同じスクロールバーの位置（画像でいうと6が一番上の位置）にできるのではないかと思い、悩んでおります。
うまく伝えられず申し訳ございません。よろしくお願い致します。
このプロパティで調べて（Web検索して）みてください
【Access】帳票フォームでRequeryを行ってもレコードの表示位置が変わらないようにする（ほそぼそプログラミング日記さん）
hiroton様
ご返信ありがとうございます。
CurrentSectionTop は試しましたが、うまくいきませんでした…
スクロールバーを一番上にして、レコードを1に合わせた状態で値を取得すると450
スクロールバーを一番上にして、レコードを13に合わせた状態で値を取得すると5130
となります。
希望は、どのレコードにいてもスクロールバーが同じ位置なら、同じ値が欲しいのです。
（画像で言うとスクロールバーが一番上なので「1」の値が欲しい）
お手数をおかけしますが、よろしくお願い致します。
スクロールバーの「位置」を知ることができるプロパティがあります
Form.CurrentSectionTop プロパティ (Access)
このプロパティで調べてみてください
回答ありがとうございます。
実際に利用しています。
コードをコピペしてデバッグ→コンパイルをしたらエラーになりました
それは実際に使っているコードですか？
＃エラーになるフィールドに設定してある式に問題があるのでしょうね。
その式を提示するとか、もう少し情報を提供ください。
一例として、下記のような感じでご希望のことは実現できますね。
オプショングループ内に12個のオプションボタンを配置して、オプションボタンのオプション値をそれぞれ 1～12 に設定。
クエリの月の抽出条件にオプショングループ名を設定。これをサブフォームのレコードソースに設定。
オプショングループの更新後処理でサブフォームを再クエリする。
https://teratail.com/questions/nq21aq7i1dpihk
https://support.microsoft.com/ja-jp/office/フォームまたはレポートのグラフを作成する-1a463106-65d0-4dbb-9d66-4ecb737ea7f7
とりあえず、基本的なことから
Accessフォームでフィルターを使って特定のレコードのみ表示する方法（工場エンジニアのAccessスキルさん）
レコードの抽出（基礎編）（cbcnet.さん）
もう少し実用的に
複数条件の抽出フォームの設計 その1（hatena chipsさん）
見た目が変わらない（データだけが変わる）ならタブコントロールの必要性は薄いです。むしろタブの数だけサブフォームを用意する必要があるので余計に手間
（見た目だけどうしてもタブを使いたいということならタブの中にはコントロールを配置しないという方法もありますが）
ひとまずリンクを参考にベースとなるフォームを作成しましょう
そのうえで、もっと具体的な内容を添えて質問しましょう
タブコントロールの各ページにサブフォームを配置しているということでしょうか。
現状、どこまでできているのでしょうか。現在の状況を詳しく提示してもらえれば、そこからの改善点をアドバイスできると思います。
サブフォームのレコードソースのテーブルのフィールド構成も提示してください。
また、メインフォームは非連結フォームですか。
コンボボックスの名前は「サイトID」で間違いないですか。
自動で[]が付くのは自動補完機能なので問題ないです。コンボボックス名に間違いがなければ、
=サイトID.Column(1)
と設定すれば、
=[サイトID].Column
と補完してくれます。
沢山のお返事ありがとうございます。
情報が私にとっては難解で、なかなかお返事が
出来なくてすみません。
今日、ちょっと分かったところが
あったので、動きました。
hatenaさんの
=サイトID.Column(1)
=サイトID.Column(2)
をちょっと試してみたところ、
「#Name?」と表示されました。
後入力した値が自動的に改変され
「=[サイトID].Column｣
となりました｡
宜しく御指南していただけましたら幸いです。
りんごさんもありがとうございます。
いつもありがとうございます。できました！
丁寧にご説明頂き助かります！
まず、前回の回答の訂正から。
前回の回答でテキストボックスと書いていましたが、ラベルの間違いです。ラベルと置き換えて読んでください。
さて、本題です。
一つのラベル内のテキストの色(前景色)を部分的に変えることはできません。
行毎に変えたいなら、行数分のラベルに分割することになりますね。
hatena様
ご指導ありがとうございます。ヒントを頂き、色付けできました。Withよく理解できました。
初心者で申し訳ございませんでした。
しかし、この方法ですと予定の案件がすべて色が変わってしまいました。考えてみれば当たり前でした。
これを一案件毎に条件毎に色を変えるのはむつかしいでしょうか？
調べて勉強しようとは思いますが、何かとっかかりのヒントを頂ければ幸いです。