印刷プレビュー　ページ番号の取得　移動

サンプル

(2005.04.17)
　 概要

 

下の所の四角部分の数字をＡＰＩを使って読みとる
四角い所に数字を送りＡＰＩのMapVirtualKeyにてエンターをシュミレートしてページ移動するサンプル


　		 ソース

　

Option Compare Database
Option Explicit

Private Type RECTL
　　Left As Long
　　Top As Long
　　Right 　As Long
　　Bottom As Long
End Type
' ウィンドウのハンドルを取得
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
'ウインドウをアクティブにさせる
Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long
'対象となるウィンドウのZオーダー上面にある ウィンドウを取得
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
'ウインドウの外側のサイズを取得
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As RECTL) As Long
'ウインドウのタイトルバーの文字列を取得する
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
'ウインドウタイトルバーの文字列の長さを取得
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
'キーストロークをシミュレートする
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
'ウインドウメッセージ
Private Const WM_MOUSEACTIVATE = &H21
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_CHAR = &H102

Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202

' GetWindow() constants.
Private Const GW_CHILD = 5

' Other constants.
Private Const HTCLIENT = 1

'
Dim hWndChild As Long
Dim hWndOSUI As Long
Dim lngWindowLocation As Long

Private Function MakeDWord(ByVal loword As Integer, ByVal hiword As Integer) As Long

MakeDWord = (hiword * &H10000) Or (loword And &HFFFF&)

End Function

Public Function GetOSUIhWnd(ByVal strReport As String) As Long

' Hold our OSUI Window dimensions.
Dim RC As RECTL
Dim intPosx As Integer

Dim lngTemp1 As Long
Dim lngReturn As Long
Dim lnghWnd As Long
Dim booSuccess As Boolean

lnghWnd = Access.Reports.Item(strReport).hWnd 'レポートのハンドル
lngReturn = SetActiveWindow(lnghWnd)

hWndOSUI = FindWindowEx(lnghWnd, 0&, "OSUI", vbNullString) '数字のある所の四角い所のウインドウ取得
lngReturn = GetWindowRect(hWndOSUI, RC) '大きさ取得
intPosx = 20 '20ピクセル
Do While intPosx < RC.Right
'Wクリックをシミュレート
lngTemp1 = MakeDWord(intPosx, (RC.Bottom - RC.Top) / 2) '20ピクセル右に行った所でWクリック
lngReturn = PostMessage(hWndOSUI, WM_LBUTTONDOWN, 1&, lngTemp1)
lngReturn = PostMessage(hWndOSUI, WM_LBUTTONUP, 1&, lngTemp1)
lngReturn = PostMessage(hWndOSUI, WM_LBUTTONDOWN, 1&, lngTemp1)
lngReturn = PostMessage(hWndOSUI, WM_LBUTTONUP, 1&, lngTemp1)
DoEvents

GetOSUIhWnd = GetWindow(hWndOSUI, GW_CHILD) '文字列･･･取得する

If GetOSUIhWnd <> 0 Then
' Store location for a next run of the function.
lngWindowLocation = lngTemp1
Exit Do
End If
' 取得できなかったので 4pixel　右に移動.
intPosx = intPosx + 4
DoEvents
Loop

End Function

Public Function GetReportPage(ByVal OSUIhwnd As Long) As Integer

Dim intPageNumber As Integer
Dim strPageNumber As String
Dim lngTemp1 As Long
Dim lngTemp2 As Long
Dim lngReturn As Long
'intPageNumber = 1
If hWndChild = 0 Or lngWindowLocation = 0 Then
GetReportPage = 0
Else
' Create the lParam.
lngTemp1 = MakeDWord(HTCLIENT, WM_LBUTTONDOWN)
' Send the Mouse Activate message.
lngReturn = SendMessage(hWndOSUI, WM_MOUSEACTIVATE, Application.hWndAccessApp, ByVal lngTemp1)
'Wクリック
lngReturn = PostMessage(hWndOSUI, WM_LBUTTONDOWN, 1&, lngWindowLocation)
lngReturn = PostMessage(hWndOSUI, WM_LBUTTONUP, 1&, lngWindowLocation)
lngReturn = PostMessage(hWndOSUI, WM_LBUTTONDOWN, 1&, lngWindowLocation)
lngReturn = PostMessage(hWndOSUI, WM_LBUTTONUP, 1&, lngWindowLocation)
'
DoEvents

lngTemp1 = MapVirtualKey(vbKeyReturn, 0&)
lngTemp2 = MakeDWord(1, CInt(lngTemp1))
lngReturn = PostMessage(hWndChild, WM_KEYDOWN, 13, lngTemp2)
lngReturn = PostMessage(hWndChild, WM_CHAR, 13, lngTemp2)
'
DoEvents
lngTemp1 = MakeDWord(HTCLIENT, WM_LBUTTONDOWN)
'
lngReturn = SendMessage(hWndOSUI, WM_MOUSEACTIVATE, Application.hWndAccessApp, ByVal lngTemp1)
'
lngReturn = PostMessage(hWndOSUI, WM_LBUTTONDOWN, 1&, lngWindowLocation)
lngReturn = PostMessage(hWndOSUI, WM_LBUTTONUP, 1&, lngWindowLocation)
'
DoEvents

'
strPageNumber = GetTextFromWindow(hWndChild)
GetReportPage = CInt(strPageNumber)
End If

End Function
’-------------------------------------
Public Sub SetReportPage(ByVal OSUIhwnd As Long, intPage As Integer)
　Dim strPageNumber As String
　Dim lngReturn As Long
　Dim lngTemp1 As Long
　Dim lngTemp2 As Long

　strPageNumber = Trim(Str(intPage))
　lngReturn = SetWindowText(hWndChild, strPageNumber)
　DoEvents

　lngTemp1 = MapVirtualKey(vbKeyReturn, 0&)
　lngTemp2 = MakeDWord(1, CInt(lngTemp1))
　lngReturn = PostMessage(hWndChild, WM_KEYDOWN, 13, lngTemp2)
　lngReturn = PostMessage(hWndChild, WM_CHAR, 13, lngTemp2)
'
　DoEvents

End Sub

’-------------------------------------

Public Function GetTextFromWindow(ByVal hWnd As Long) As String

　Dim strWindow As String
　Dim lngReturn As Long

　' buffer Create
　strWindow = String(GetWindowTextLength(hWnd) + 1, vbNullChar)
　' Get the window's text.
　lngReturn = GetWindowText(hWnd, strWindow, Len(strWindow))
　strWindow = Left(strWindow, Len(strWindow) - 1)

　GetTextFromWindow = strWindow

End Function
’-------------------------------------
Private Sub コマンド1_Click()
　　DoCmd.OpenReport "R_01名簿", acViewPreview, "", "" ' レポートを表示
　　hWndChild = GetOSUIhWnd("R_01名簿") 'hWndChildは後で色々使う
End Sub
’-------------------------------------
Private Sub コマンド2_Click()
　　テキスト0.Value = GetReportPage(hWndChild)
End Sub
’-------------------------------------
Private Sub コマンド3_Click()
　　Dim repPage As Integer
　　repPage = テキスト0.Value
　　DoCmd.PrintOut "R_01名簿", repPage, repPage
End Sub
’-------------------------------------
Private Sub コマンド4_Click()
　　Dim repPage As Integer
　　repPage = テキスト0.Value

　　Call SetReportPage(hWndChild, repPage)
End Sub
　

　

ここに掲載された情報を使用したことによって発生した、いかなる損害に対しても
管理者であるしゃくは一切責任を負いません。

since 16 APR. 2005 By Shaku