アクセスＶＢＡ フォームのスクロールバーを動かす。

アクセスＶＢＡ　フォームのスクロールバーを動かす。

作成したフォームの横スクロールバーポジションを、一番右端や左端にしてしまうことをＶＢＡ側でしたいのですが可能でしょうか？

コードがわかりません。お願い致します。

No.2 ベストアンサー 回答者： piroin654 回答日時： 2010/02/12 00:09

動かしてどうするの？という感じ

ですが、動かすだけならボタン
二つで右、左です。

Private Sub scrollLeft_Click()
Dim lnFormWidth As Long
Dim lnDistance As Long

lnFormWidth = Me.Width
lnDistance = lnFormWidth - CurrentSectionLeft
Me.SetFocus
GoToPage 1, , lnDistance
End Sub

Private Sub scrollRight_Click()
Dim lnFormWidth As Long
Dim lnDistance As Long

lnFormWidth = Me.Width
lnDistance = lnFormWidth - CurrentSectionLeft
Me.SetFocus
GoToPage 1, lnDistance
End Sub

簡潔ですが、見つけにくいですね、
こんなもの。

この回答への補足

＞動かしてどうするの？

表形式のフォームの中で使わせて頂きます。
カーソルキーを押すことで、エクセル風にセルを移動できるようにしたフォームです。

ただ、問題が２つ。
１.左右端のフィールドにフォーカスされた時に、左右それぞれのフォームの端を表示しきれない。
　　　　左右の余白部分が見えない。
２.フォームデザインがまずかったのか、左右キーによる左右スクロールするとヘッダー部分に置いたボタン等の表示が欠ける。
　　　　手動でスクロールバーを動かすと、表示は欠けない。

という理由でした。

そこで、
Private Sub scrollLeft_Click()
Private Sub scrollRight_Click()
を、それぞれ
function scrollLeft()
function scrollRight()
と、して
左右端のフィールドにファーカスが入ったら、scrollLeft・scrollRightを呼び出す、としました。

右端に行った時は、希望どうりの動きをしてくれます。
ただ、左端にフォーカスが入った瞬間、上にもスクロールされてしまい、そのレコードは一番上に上がってしまいます。

もう少し、ご教示頂ければとても幸です。

ちなみに、２．の方は未解決です。
ＶＢ側からスクロールバー操作させたらできるかと思ったのですが・・・
フォームのRepaintができればよいのですが。


-----------------------------------------参考コード------------------------------------------------
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
　　’左右端でストップさせる
If ActiveControl.Name = "左端フィールド" And KeyCode = vbKeyLeft Then KeyCode = 0
If ActiveControl.Name = "右端フィールド" And KeyCode = vbKeyRight Then KeyCode = 0
'レコードの移動
If KeyCode = vbKeyDown Then レコード移動_次
If KeyCode = vbKeyUp Then レコード移動_前
End Sub
'------------------------------------------------
Private Sub 左端フィールド_GotFocus()
　　　scrollLeft
End Sub
Private Sub 右端フィールド_GotFocus()
　　　scrollRight
End Sub
'------------------------------------------------
Function レコード移動_次()
DoCmd.GoToRecord , "", acNext
End Function
'------------------------------------------------
Function レコード移動_前()
DoCmd.GoToRecord , "", acPrevious
End Function
'------------------------------
Function scrollLeft()
Dim lnFormWidth As Long
Dim lnDistance As Long

lnFormWidth = Me.Width
lnDistance = lnFormWidth - CurrentSectionLeft
Me.SetFocus
GoToPage 1, , lnDistance
End Function
'----------------------------
Function scrollRight()
Dim lnFormWidth As Long
Dim lnDistance As Long

lnFormWidth = Me.Width
lnDistance = lnFormWidth - CurrentSectionLeft
Me.SetFocus
GoToPage 1, lnDistance
End Function

補足日時：2010/02/12 21:33

No.10 回答者： piroin654 回答日時： 2010/02/13 23:44

おめでとうございます。

幅1ミリの非表示でいいです。

この回答へのお礼

長時間にわたり、申し訳ありませんでした。

今回の質問と関係ないですが、アクセス2007、手こずってます。2003がよかったなぁ。

今後もよろしくお願い致します。

ありがとうございました。

お礼日時：2010/02/13 23:56

No.9 回答者： piroin654 回答日時： 2010/02/13 03:34

送ったコードの

Me.SetFocus
の部分をコメントアウト
するなどしてみてください。

この回答への補足

>ダミーフィールドですか。
ヒントになりました。

左右端にダミーのテキストボックスを置くことで、問題の解決となりました。

きっと、皆さんの知っているワザだったりして。

ありがとうございます。

補足日時：2010/02/13 21:33

No.8 回答者： piroin654 回答日時： 2010/02/13 03:15

別のコードを送ってみます。

仕様は似たようなものですが、
試してみてください。

Private Sub botmLeft_Click()
Dim lnFormWidth As Long
Dim lnDistance As Long
Dim ctl As Control

lnFormWidth = Me.Width
Me.SetFocus
Screen.PreviousControl.SetFocus
Set ctl = ActiveControl
lnDistance = lnFormWidth - CurrentSectionLeft
Requery
Me.SetFocus
GoToPage 1, , lnDistance
Requery
ctl.SetFocus
Set ctl = Nothing


' lnFormWidth = Me.Width
' lnDistance = lnFormWidth - CurrentSectionLeft
'
' Me.SetFocus
' GoToPage 1, , lnDistance
' Requery
End Sub

Private Sub botmRight_Click()
Dim lnFormWidth As Long
Dim lnDistance As Long
Dim ctl As Control

lnFormWidth = Me.Width
Me.SetFocus
Screen.PreviousControl.SetFocus
Set ctl = ActiveControl
lnDistance = lnFormWidth - CurrentSectionLeft
Requery
Me.SetFocus
GoToPage 1, lnDistance
Requery
ctl.SetFocus
Set ctl = Nothing


' lnFormWidth = Me.Width
' lnDistance = lnFormWidth - CurrentSectionLeft
'
' Me.SetFocus
' Requery
' GoToPage 1, lnDistance
End Sub

この回答への補足

変化なしです。

Requeryをつけると挙動不審です。

今日は遅いので、もう休ませていただきます。

ありがとうございました。

補足日時：2010/02/13 03:37

No.7 回答者： piroin654 回答日時： 2010/02/13 02:57

左への移動時のRequeryの位置は

あっていますか。

Me.SetFocus
GoToPage 1, , lnDistance
Requery
End Sub

この回答への補足

＞Requeryの位置はあっていますか。

はい。
でも、Requeryはあってもなくても状況はいっしょです。

補足日時：2010/02/13 03:08

No.6 回答者： piroin654 回答日時： 2010/02/13 02:53

左への移動時のRequeyの位置はあって

いますか。

Me.SetFocus
GoToPage 1, , lnDistance
Requery
End Sub

この回答への補足

Requeryをつけると、
フォーカスはレコードの先頭に移動する
でした。

Requeryをはずすと、
フォーカスされたレコード位置は変わらず、画面の一番上にスクロール
です。

補足日時：2010/02/13 03:21

No.5 回答者： piroin654 回答日時： 2010/02/13 01:47

コンボボックスは連結ですか。

ソースは値リストですか、
テーブル/クエリ　ですか。

この回答への補足

コンボボックスは連結です。
ソースは値リストで、テーブルからです。

この左端をコンボックスでない普通のフィールドにしても、動作は同じでした。

補足日時：2010/02/13 02:34

No.4 回答者： piroin654 回答日時： 2010/02/13 01:38

右への移動の

Requery
はコメントアウトしてみてください。
Dim ctl As Control
は使っていません。使いかけたのですが、
こちらの状況では必要ないので。

左の状況はどういうものになっていますか。
データのスクロールが改善していない、とい
うことですか。全体がスクロールしている
ということですか。

こちらのフォーム設定は
表内部はコンボ、テキスト・・・・テキスト
としています。
提示されているコードと関数の整合性
を見極める必要があるので、ちょっと
考えます。

この回答への補足

最初のscrollLeft()で、正常。
そのまま、←キー（左）を押し続けると、フォーカスされたレコード位置はそのままで、フォーム全体がスクロール。

という状況です。

深夜まで申しわけありません。
よろしくお願いいたします。

補足日時：2010/02/13 02:44

No.3 回答者： piroin654 回答日時： 2010/02/12 23:14

>表形式のフォームの中で

ちょっと実験してみました。
確かに、左に寄せたときデータが
移動していました。そこでコードに
少し手を加えてみたのですが。
こちらのフォーム設定が合えば
いいのですが。左のフィールドは
表のフィールドなのでしょうか。
ダミーフィールドですか。
ちょっとそのへんは判りませんが、
表の再描画を入れました。

Private Sub botmLeft_Click()
Dim lnFormWidth As Long
Dim lnDistance As Long

lnFormWidth = Me.Width
lnDistance = lnFormWidth - CurrentSectionLeft

Me.SetFocus
GoToPage 1, , lnDistance
Requery
End Sub

Private Sub botmRight_Click()
Dim lnFormWidth As Long
Dim lnDistance As Long
Dim ctl As Control

lnFormWidth = Me.Width
lnDistance = lnFormWidth - CurrentSectionLeft

Me.SetFocus
Requery
GoToPage 1, lnDistance
End Sub

関数形式になっていませんが、
変更箇所はわかりますね。

この回答への補足

ご回答頂きましたコードですが、

botmLeft_Click()　’左
　　「Requery」が追加されただけでしょうか？

Private Sub botmRight_Click()　’右
　　　Dim ctl As Control　使われていない？
　　「Requery」追加すると、右端でストップせず他のフィールドに飛んで行ってしまいます。
　　　でも、右端の件は解決です。

左端がいぜんとして、解決していません。

左端のフィールドは、実はコンボボックスです。
ダミーではありません。
--------------------------------------------
Private Sub 左端のフィールド_Enter()

Me![左端のフィールド].Dropdown

　　上下カーソルキーの動きはコンボボックス内のみのフラッグ立てる

End Sub
---------------------------------------------
実験してみたのですが、普通のテキストボックスでも同じ挙動でした。


ボタンの欠け表示の件は解決しました。
フォームヘッダーの色にグラデーションの付くスタイルだと欠けになります。
一色タイプだと欠けませんでした。

今一度、お教え頂けないでしょうか？

補足日時：2010/02/13 00:16

No.1 回答者： tsukasa-12r 回答日時： 2010/02/11 23:36

スクロール位置を +10 にする例です。

==============================================================
Private Declare Function GetWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal uCmd As Long) As Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetScrollInfo Lib "user32.dll" (ByVal hWnd As Long, ByVal nBar As Long, ByRef si As SCROLLINFO) As Long
Private Declare Function SetScrollInfo Lib "user32.dll" (ByVal hWnd As Long, ByVal nBar As Long, ByRef si As SCROLLINFO, ByVal blnRedraw As Long) As Long

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

Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const SB_HORZ = 0
Private Const SB_CTL = 2
Private Const SIF_POS = 4

Private Sub コマンド0_Click()
　　Dim hWnd As Long
　　Dim strClassName As String
　　Dim lngReturn As Long
　　Dim intLen As Integer
　　Dim si As SCROLLINFO

　　hWnd = GetWindow(Me.hWnd, GW_CHILD)
　　Do
　　　　strClassName = Space(100)
　　　　lngReturn = GetClassName(hWnd, strClassName, 100)
　　　　If lngReturn Then
　　　　　　intLen = InStr(strClassName, Chr(0))
　　　　　　strClassName = Left(strClassName, intLen - 1)
　　　　　　If strClassName = "ScrollBar" Then
　　　　　　　　si.cbSize = 28
　　　　　　　　si.fMask = SIF_POS
　　　　　　　　lngReturn = GetScrollInfo(hWnd, SB_CTL, si)
　　　　　　　　si.nPos = si.nPos + 10
　　　　　　　　lngReturn = SetScrollInfo(hWnd, SB_CTL, si, True)
　　　　　　　　Exit Do
　　　　　　End If
　　　　End If
　　　　hWnd = GetWindow(hWnd, GW_HWNDNEXT)
　　Loop While hWnd
End Sub
==============================================================
インデントのために全角空白を使用しています。

この回答へのお礼

うまく、動きません。エラーになります。
私の技量では、コードを理解できませんでした。

今後の参考とさせて頂きます。

ありがとうございました。

お礼日時：2010/02/12 21:37