（祝）東京オリンピック！

（祝）北京オリンピック！

サンプル集1



   


   

   


      
COPY


      
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. '------------------------------------------------------------
  5. Private TP          As Long
  6. Private X           As Long
  7. Private Y           As Long
  8. Private cx          As Long
  9. Private cy          As Long
  10. Private memReportName       As String
  11. '------------------------------------------------------------
  12. '
  13. Public Property Let ReportName(ByVal NewName As String)
  14.     Dim Ret             As Variant
  15.     Dim Rpt             As Report
  16.     Dim OldName         As String
  17.     On Error Resume Next
  18.  
  19.     OldName = memReportName
  20.     If OldName <> NewName Then
  21.         '表示しているレポートを閉じる
  22.         Then Rpt In Reports
  23.             If Rpt.Name = OldName Then
  24.                 DoCmd.Close acReport, OldName
  25.                 Exit For
  26.             End If
  27.         Next Rpt
  28.  
  29.         '新しいレポートを開く
  30.         DoCmd.OpenReport NewName, acViewPreview
  31.         memReportName = NewName
  32.         Ret = MoveWindow(Reports(memReportName).hwnd, X / TP, Y / TP, cx / TP, cy / TP, 1)
  33.  
  34.         '新しいレポートの子ウィンドウを親ウィンドウのフォームに設定
  35.         SetParent Reports(memReportName).hwnd, Me.hwnd
  36.     End If
  37.  
  38. End Property
  39.  
  40. '------------------------------------------------------------
  41. Public Property Get ReportName() As String
  42.  
  43.     ReportName = memReportName
  44.  
  45. End Property
  46.  
  47. '------------------------------------------------------------
  48. Private Sub Form_Load()
  49.     Dim Ret             As Variant
  50.     On Error Resume Next
  51.  
  52.     Me.btnDummy.SetFocus
  53.  
  54.     TP = TwipPixel
  55.     
  56.     'フォームに表示するレポートの位置とサイズを調整します
  57.     X = 0
  58.     Y = Me.フォームヘッダー.Height      'Y = Me.コマンド0.Heightでもよい
  59.     cx = Me.InsideWidth
  60.     cy = Me.InsideHeight - Me.フォームヘッダー.Height
  61.  
  62.     'Win32API関数を使ってアクセスを最小化します
  63.     CloseWindow Application.hWndAccessApp
  64.  
  65.     'フォームの OpenArgs プロパティを使用します
  66.     If Len(memReportName) = 0 Then
  67.         Exit Sub
  68.     Else
  69.         memReportName = Me.OpenArgs
  70.     End If
  71.  
  72.     'レポートをプレビューします
  73.     DoCmd.OpenReport ReportName, acViewPreview
  74.  
  75.     Ret = MoveWindow(Reports(ReportName).hwnd, X / TP, Y / TP, cx / TP, cy / TP, 1)
  76.  
  77.     'レポートの子ウィンドウを親ウィンドウのフォームに設定
  78.     SetParent Reports(ReportName).hwnd, Me.hwnd
  79.  
  80. End Sub
  81.  
  82. '------------------------------------------------------------
  83. Private Sub Form_Resize()
  84.     Dim Ret             As Variant
  85.     On Error Resume Next
  86.  
  87.     'フォームに表示するレポートの位置とサイズを調整します
  88.     X = 0
  89.     Y = Me.フォームヘッダー.Height      'Y = Me.コマンド0.Heightでもよい
  90.     cx = Me.InsideWidth
  91.     cy = Me.InsideHeight - Me.フォームヘッダー.Height
  92.  
  93.     Ret = MoveWindow(Reports(ReportName).hwnd, X / TP, Y / TP, cx / TP, cy / TP, 1)
  94.  
  95. End Sub
  96.  
  97. '------------------------------------------------------------
  98. Private Sub コマンド0_Click()
  99.  
  100.     Me.btnDummy.SetFocus
  101.  
  102.     DoCmd.SelectObject acReport, ReportName, False
  103.     DoCmd.RunCommand acCmdPrint
  104.  
  105. End Sub
  106.  
  107. '------------------------------------------------------------
  108. Private Sub コマンド1_Click()
  109.  
  110.     Me.btnDummy.SetFocus
  111.  
  112.     DoCmd.Close acReport, ReportName
  113.     DoCmd.Close acForm, Me.Name
  114.  
  115. End Sub
  116.  
  117. '------------------------------------------------------------
  118. Private Sub コマンド2_Click()
  119.  
  120.     Me.btnDummy.SetFocus
  121.  
  122.     ComForeColor "コマンド2"
  123.  
  124.     If コマンド2.ForeColor = vbRed Then
  125.         ChangeReport コマンド2.Caption
  126.     End If
  127.  
  128. End Sub
  129.  
  130. '------------------------------------------------------------
  131. Private Sub コマンド3_Click()
  132.  
  133.     Me.btnDummy.SetFocus
  134.  
  135.     ComForeColor "コマンド3"
  136.  
  137.     If コマンド3.ForeColor = vbRed Then
  138.         ChangeReport コマンド3.Caption
  139.     End If
  140.  
  141. End Sub
  142.  
  143. '------------------------------------------------------------
  144. Private Sub ComForeColor(ByVal strName As String)
  145.     Dim Ctrl            As Control
  146.  
  147.     Then Ctrl In Me.Controls
  148.         If Ctrl.Name = strName Then
  149.             Ctrl.ForeColor = vbRed
  150.         Else
  151.             If Ctrl.ForeColor <> Me.コマンド0.ForeColor Then
  152.                 Ctrl.ForeColor = Me.コマンド0.ForeColor
  153.             End If
  154.         End If
  155.     Next Ctrl
  156.  
  157. End Sub
  158.  
  159. '-------------------------------------------------------------------
  160. Private Sub ChangeReport(ByVal strCap As String)
  161.     Dim BUF             As String
  162.  
  163.     Select Case strCap
  164.     Case "帳票"
  165.         BUF = "レポート1"
  166.     Case "タックシール"
  167.         BUF = "レポート2"
  168.     End Select
  169.   
  170.     ReportName = BUF
  171.   
  172. End Sub 


   

   









   


      


      


      


      


      


   


   

   


      
COPY


      
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. 'パラメータ
  5. 'hWnd       ウィンドウへのハンドル､および間接的に､ウィンドウが属するクラス
  6. 'nIndex     取得する値へのゼロベースのオフセット
  7. Public Const GWL_EXSTYLE = -20  '拡張ウィンドウスタイルを取得します
  8. Public Const GWL_STYLE = -16    'ウィンドウスタイルを取得します
  9. Public Const GWL_HWNDPARENT = -8    '親ウィンドウあれば、そのハンドルを取得します
  10. Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
  11.             ByVal hWnd As Long, _
  12.             ByVal nIndex As Long) As Long
  13.  
  14. 'パラメータ
  15. 'hWnd       ウィンドウへのハンドル､および間接的に､ウィンドウが属するクラス
  16. 'nIndex     取得する値へのゼロベースのオフセット
  17. 'dwNewLong  置換値
  18. 'GetWindowLongAで得られた値(Val) に対して、最小化ボタンを無効にする場合[dwNewLong = Val And Not WS_MINIMIZEBOX]とする
  19. Public Const WS_OVERLAPPED = &H0        'オーバーラップウィンドウ
  20. Public Const WS_MAXIMIZEBOX = &H10000   '最大化ボタン
  21. Public Const WS_MINIMIZEBOX = &H20000   '最小化ボタン
  22. Public Const WS_SIZEBOX = &H40000       'サイズ変更境界
  23. Public Const WS_THICKFRAME = &H40000    'サイズ変更境界
  24. Public Const WS_SYSMENU = &H80000       'ウィンドウメニュー WS_CAPTIONスタイルも指定する必要があります
  25. Public Const WS_CAPTION = &HC00000      'タイトルバー
  26. Public Const WS_HSCROLL = &H100000      '水平スクロールバー
  27. Public Const WS_VSCROLL = &H200000      '垂直スクロールバー
  28. Public Const WS_BORDER = &H800000       '境界線
  29. Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
  30.             ByVal hWnd As Long, _
  31.             ByVal nIndex As Long, _
  32.             ByVal dwNewLong As Long) As Long


   

   









   


      


      


      


      


      


   


   

   


      
COPY


      
  1. '----------------------------------------------------------------------
  2. 'パラメータ
  3. 'hWndChild　    子ウィンドウへのハンドル
  4. 'hWndNewParent　新しい親ウィンドウへのハンドル
  5. Public Declare PtrSafe Function SetParent Lib "user32" ( _
  6.             ByVal hWndChild As Long, _
  7.             ByVal hWndNewParent As Long) As Long
  8.  
  9. '----------------------------------------------------------------------
  10. 'パラメータ
  11. 'hwnd    ウィンドウへのハンドル
  12. 'X       ウィンドウの左側の新しい位置 (ピクセル単位)
  13. 'Y       ウィンドウの上部の新しい位置 (ピクセル単位)
  14. 'nWidth  ウィンドウの新しい幅 (ピクセル単位)
  15. 'nHeight ウィンドウの新しい高さ (ピクセル単位)
  16. 'bRepaintウィンドウを再描画するかどうかを示します（1:再描画  0:再描画しない）
  17. Public Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hwnd As Long, _
  18.                                                          ByVal X As Long, _
  19.                                                          ByVal Y As Long, _
  20.                                                          ByVal nWidth As Long, _
  21.                                                          ByVal nHeight As Long, _
  22.                                                          ByVal bRepaint As Long) As Long
  23.                                                          
  24. '----------------------------------------------------------------------
  25. 'パラメータ
  26. 'hWnd       ウィンドウへのハンドル
  27. 'hWndInsertAfter Zオーダーで配置されたウィンドウの前にあるウィンドウのハンドル このパラメーターは､ウィンドウハンドルまたは次の値のいずれかでなければなりません
  28. Public Const HWND_TOP = &H0             'ウィンドウをZオーダーの一番上に配置します
  29. Public Const HWND_TOPMOST = -1          'ウィンドウを最上位以外のすべてのウィンドウの上に配置します
  30. 'X          クライアント座標での､ウィンドウの左側の新しい位置 (ピクセル単位)
  31. 'Y          クライアント座標でのウィンドウ上部の新しい位置 (ピクセル単位)
  32. 'cx         ウィンドウの新しい幅 (ピクセル単位)
  33. 'cy         ウィンドウの新しい高さ (ピクセル単位)
  34. 'uFlags     ウィンドウのサイズ変更および配置フラグ このパラメーターは､以下の値の組み合わせにすることができます
  35. Public Const SWP_NOMOVE = &H2           '現在の位置を保持します（ XおよびYパラメーターを無視します）
  36. Public Const SWP_NOSIZE = &H1           '現在のサイズを保持します（ cxおよびcyパラメーターを無視します）
  37. Public Const SWP_SHOWWINDOW = &H40      'ウィンドウを表示します
  38. Public Declare PtrSafe Function SetWindowPos Lib "user32.dll" ( _
  39.             ByVal hwnd As Long, _
  40.             ByVal hWndInsetAfter As Long, _
  41.             ByVal X As Long, _
  42.             ByVal Y As Long, _
  43.             ByVal cx As Long, _
  44.             ByVal cy As Long, _
  45.             ByVal uFlags As Long _
  46.             ) As Long


   

   









   


      


      


      


      


      


   


   

   


      
COPY


      
  1. '----------------------------------------------------------------------
  2. Private Const HORZRES       As Long = 8     '画面の幅 (ピクセル単位) 
  3. Private Const VERTRES       As Long = 10    '画面の高さ (ピクセル単位)
  4. Private Const BITSPIXEL     As Long = 12    '各ピクセルの隣接するカラービットの数
  5. Private Const LOGPIXELSX    As Long = 88    '画面の幅方向の論理インチあたりのピクセル数
  6. Private Const LOGPIXELSY    As Long = 90    '画面の高方向の論理インチあたりのピクセル数
  7.  
  8. Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
  9.  
  10. Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  11.  
  12. Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
  13.  
  14. '----------------------------------------------------------------------
  15. Public Function TwipPixel() As Long
  16.     Dim DskhWnd     As Long
  17.     Dim nhDc        As Long
  18.     Dim Bit         As Long
  19.     Dim nWidth      As Long
  20.     Dim nHeight     As Long
  21.  
  22.     'デスクトップのハンドル
  23.     DskhWnd = GetDesktopWindow
  24.  
  25.     'デスクトップのデバイスコンテキストハンドル
  26.     nhDc = GetDC(DskhWnd)
  27.  
  28.     '画面の横幅
  29.     nWidth = GetDeviceCaps(nhDc, HORZRES)
  30.  
  31.     '画面の縦幅
  32.     nHeight = GetDeviceCaps(nhDc, VERTRES)
  33.  
  34.     'ピクセル当たりのビット数
  35.     Bit = GetDeviceCaps(nhDc, BITSPIXEL)
  36.  
  37.     '1インチ＝1440Twips
  38.     TwipPixel = CLng(1440 / GetDeviceCaps(nhDc, LOGPIXELSX))
  39.  
  40. End Function