SIBAINUのメモ帳

FORMのイベントプロシージャ

親フォーム：　フォームヘッダーにコマンドボタン[CmdPrintPreView][CmdClose][CmdItiran]
[CmdTacSheel][CmdSelect]を配置し、セクション[詳細]に子フォーム、プリントプレビューを
描画するようにしています。

COPY

Option Compare Database
Option Explicit

Private TP          As Long
Private X           As Long
Private Y           As Long
Private cx          As Long
Private cy          As Long
Private memReportName   As String
Private memFormName     As String
Private memSumi         As Long
Private CapRepo     As Dictionary
Private Const CmdWidth = 1701
Private Const Margin = 56
'
'************************************************************
Public Property Let ReportName(ByVal NewName As String)
    Dim Ret             As Variant
    Dim Rpt             As Report
    Dim Frm             As Form
    Dim OldName         As String
    On Error Resume Next

    '表示しているレポートを閉じる
    If Len(memReportName) > 0 Then
        For Each Rpt In Reports
            If Rpt.Name = memReportName Then
                DoCmd.Close acReport, Rpt.Name
            End If
        Next Rpt
    End If

    '表示しているフォームを閉じる
    If Len(memFormName) > 0 Then
        For Each Frm In Forms
            If Frm.Name = memFormName Then
                DoCmd.Close acForm, Frm.Name
            End If
        Next Frm
    End If

    '新しいレポートを開く
    DoCmd.OpenReport NewName, acViewPreview, , , , Sumi
    memReportName = NewName
    memFormName = ""
    Ret = MoveWindow(Reports(memReportName).hWnd, X / TP, Y / TP, cx / TP, cy / TP, 1)

    '新しいレポートの子ウィンドウを親ウィンドウのフォームに設定
    SetParent Reports(memReportName).hWnd, Me.hWnd
    DoCmd.SelectObject acReport, memReportName

    Call ComForeColor

End Property

Public Property Get ReportName() As String

    ReportName = memReportName

End Property
'
'************************************************************
Public Property Let CFormName(ByVal NewName As String)
    Dim Ret             As Variant
    Dim Rpt             As Report
    Dim Frm             As Form
    Dim SetValue        As Long
    On Error Resume Next

    '表示しているレポートを閉じる
    If Len(memReportName) > 0 Then
        For Each Rpt In Reports
            If Rpt.Name = memReportName Then
                DoCmd.Close acReport, Rpt.Name
            End If
        Next Rpt
    End If

    '表示しているフォームを閉じる
    If Len(memFormName) > 0 Then
        For Each Frm In Forms
            If Frm.Name = memFormName Then
                DoCmd.Close acForm, Frm.Name
            End If
        Next Frm
    End If

    '新しいフォームを開く
    DoCmd.OpenForm NewName, acNormal
    memFormName = NewName
    memReportName = ""
    Ret = MoveWindow(Forms(memFormName).hWnd, X / TP, Y / TP, cx / TP, cy / TP, 1)

    '新しいフォームの子ウィンドウを親ウィンドウのフォームに設定
    SetParent Forms(memFormName).hWnd, Me.hWnd
    DoCmd.SelectObject acForm, memFormName

    Call ComForeColor

End Property

Public Property Get CFormName() As String

    CFormName = memFormName

End Property
'
'************************************************************
Public Property Let Sumi(Val As Long)

    memSumi = Val

End Property

Public Property Get Sumi() As Long

    Sumi = memSumi

End Property
'
'************************************************************
Private Sub Form_Load()
    Dim Ret             As Variant
    Dim SetValue        As Long
    On Error Resume Next

    Me.btnDummy.SetFocus

    Set CapRepo = New Dictionary
    With CapRepo
        .Add "帳票", "レポート1"
        .Add "タックシール", "レポート2"
        .Add "選択", "選択"
    End With

    memReportName = ""
    memFormName = ""

    '現在の設定値を取得
    SetValue = GetWindowLong(Me.hWnd, GWL_STYLE)

    '最小化ボタンを無効
    SetValue = SetValue And Not WS_MINIMIZEBOX

    '設定値をセット
    SetWindowLong Me.hWnd, GWL_STYLE, SetValue

    TP = TwipPixel

    'フォームに表示するレポートの位置とサイズを調整します
    X = 0
    Y = Me.フォームヘッダー.Height      'Y = Me.CmdPrintPreView.Heightでもよい
    cx = Me.InsideWidth
    cy = Me.InsideHeight - Me.フォームヘッダー.Height

    'Win32API関数を使ってアクセスを最小化します
    CloseWindow Application.hWndAccessApp

    'フォームの OpenArgs プロパティを使用します
    If Me.OpenArgs Is Nothing Then
        ReportName = CapRepo("帳票")
    Else
        ReportName = Me.OpenArgs
    End If

    If ((CmdWidth + Margin) * 2) < ((cx / 2) - ((CmdWidth * 3 + Margin * 2) / 2)) Then
        Me.CmdItiran.Left = (cx / 2) - ((CmdWidth * 3 + Margin * 2) / 2)
    Else
        Me.CmdItiran.Left = (CmdWidth + Margin) * 2
    End If
    Me.CmdTacSheel.Left = Me.CmdItiran.Left + (CmdWidth + Margin)
    Me.CmdSelect.Left = Me.CmdTacSheel.Left + (CmdWidth + Margin)

End Sub
'
'************************************************************
Private Sub Form_Close()

    Set CapRepo = Nothing

End Sub
'
'************************************************************
Private Sub Form_Resize()
    Dim Ret             As Variant
    On Error Resume Next

    'フォームに表示するレポートの位置とサイズを調整します
    X = 0
    Y = Me.フォームヘッダー.Height      'Y = Me.CmdPrintPreView.Heightでもよい
    cx = Me.InsideWidth
    cy = Me.InsideHeight - Me.フォームヘッダー.Height

    If Len(ReportName) > 0 Then
        Ret = MoveWindow(Reports(ReportName).hWnd, X / TP, Y / TP, cx / TP, cy / TP, 1)
    End If

    If Len(CFormName) > 0 Then
        Ret = MoveWindow(Forms(CFormName).hWnd, X / TP, Y / TP, cx / TP, cy / TP, 1)
    End If

    If ((CmdWidth + Margin) * 2) < ((cx / 2) - ((CmdWidth * 3 + Margin * 2) / 2)) Then
        Me.CmdItiran.Left = (cx / 2) - ((CmdWidth * 3 + Margin * 2) / 2)
    Else
        Me.CmdItiran.Left = (CmdWidth + Margin) * 2
    End If
    Me.CmdTacSheel.Left = Me.CmdItiran.Left + (CmdWidth + Margin)
    Me.CmdSelect.Left = Me.CmdTacSheel.Left + (CmdWidth + Margin)

End Sub
'
'************************************************************
Private Sub CmdPrintPreView_Click()
    On Error Resume Next

    Me.btnDummy.SetFocus

    If Len(ReportName) = 0 Then
        Exit Sub
    End If

    DoCmd.SelectObject acReport, ReportName, False
    DoCmd.RunCommand acCmdPrint

End Sub
'
'************************************************************
Private Sub CmdClose_Click()

    Me.btnDummy.SetFocus

    If Len(ReportName) > 0 Then
        DoCmd.Close acReport, ReportName
    End If

    If Len(CFormName) > 0 Then
        DoCmd.Close acForm, CFormName
    End If

    DoCmd.Close acForm, Me.Name

End Sub
'
'************************************************************
Private Sub CmdItiran_Click()

    Me.btnDummy.SetFocus

    ChangeReport CmdItiran.Caption

End Sub
'
'************************************************************
Private Sub CmdTacSheel_Click()
    Dim Res             As String
    Dim hIMC            As Long
    Dim hWnd            As Long

    Me.btnDummy.SetFocus

    If MsgBox("使用済のシールがありますか", vbYesNo, "確認") = vbYes Then
        'IMEをオフにします
        hWnd = Application.hWndAccessApp
        hIMC = ImmGetContext(hWnd)
        If ImmGetOpenStatus(hIMC) Then
            ImmSetOpenStatus hIMC, 0
        End If
        ImmReleaseContext hWnd, hIMC

        Res = InputBox("使用した枚数を入力してください", "使用枚数")
        Res = StrConv(Res, vbNarrow)
    End If

    If isSUTI(Res) Then
        Sumi = CLng(Res)
    Else
        Sumi = 0
    End If

    ChangeReport CmdTacSheel.Caption

End Sub
'
'************************************************************
Private Sub CmdSelect_Click()

    Me.btnDummy.SetFocus

    ChangeForm CmdSelect.Caption

End Sub
'
'************************************************************
Private Sub ComForeColor()
    Dim Ctrl            As Control

    For Each Ctrl In Me.Controls
        If TypeName(Ctrl) = "CommandButton" Then
            If CapRepo.Exists(Ctrl.Caption) Then
                If CapRepo(Ctrl.Caption) = memReportName Then
                    Ctrl.ForeColor = vbRed
                ElseIf CapRepo(Ctrl.Caption) = memFormName Then
                    Ctrl.ForeColor = vbRed
                Else
                    If Ctrl.ForeColor <> Me.CmdPrintPreView.ForeColor Then
                        Ctrl.ForeColor = Me.CmdPrintPreView.ForeColor
                    End If
                End If

            End If
        End If
    Next Ctrl

End Sub
'
'************************************************************
Private Sub ChangeReport(ByVal strCap As String)

    If CapRepo.Exists(strCap) Then
        ReportName = CapRepo(strCap)
    End If
  
End Sub
'
'************************************************************
Private Sub ChangeForm(ByVal strCap As String)

    If CapRepo.Exists(strCap) Then
        CFormName = CapRepo(strCap)
    End If
  
End Sub

ウィンドの状態を取得するAPI32

COPY

Option Compare Database
Option Explicit

Public Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String _
            ) As Long

'ウインドウ（コントロール）のキャプションを取得するAPI関数

  '<引数>
  'hWnd：ウインドウのハンドル
  'lpString：文字列を格納するバッファ
  'MaxCoun：文字列のバッファサイズ

  '<戻り値>
  ' 文字列のバイト数
  
Public Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
        ByVal hWnd As Long, _
        ByVal lpString As String, _
        ByVal cch As Long) As Long

'子ウインドウを列挙するAPI関数

 '<引数>
 'hWndParent：親ウインドウのハンドル
 'lpEnumFunc：コールバック関数へのポインタ
 'lParam：コールバック関数へ渡す32ビット値
 
 '<戻り値>
 '正常終了0以外
 
Public Declare PtrSafe Function EnumChildWindows Lib "user32" ( _
        ByVal hWndParent As Long, _
        ByVal lpEnumFunc As Long, _
        ByVal lParam As Long) As Long

Public Function myProc(ByVal Val As Long) As Long
    myProc = Val
End Function

'-------------------------------------------------
'■関数名　　　EnumChildProc
'■用途　　　　子ウインドウ（コントロール）を列挙する
'■引数　　　　hWnd：子ウインドウのハンドル
'-------------------------------------------------

Public Function EnumChildProc(ByVal hWnd As Long) As Long

Dim Ret As Long
Dim Leng As Long
Dim Name As String
    
'バッファ確保
Name = String(255, Chr(0))
Leng = Len(Name)
   
'名前を取得する
Ret = GetWindowText(hWnd, Name, Leng)
    
If Ret <> 0 Then
    If Name = "レポート1" Then
        Call AdjustSize(hWnd, 0, 0, 0, 0)
    End If
End If

EnumChildProc = 1

End Function


'ウィンドウサイズを変更する関数
Public Sub AdjustSize(hWnd As Long, X As Long, Y As Long, cx As Long, cy As Long)

    Call SetWindowPos(hWnd, -1, Y, Y, cx, cy, SWP_NOMOVE Or SWP_SHOWWINDOW)

End Sub

作成する関数

COPY

Option Compare Database
Option Explicit

Private Const HORZRES       As Long = 8
Private Const VERTRES       As Long = 10
Private Const BITSPIXEL     As Long = 12
Private Const LOGPIXELSX    As Long = 88
Private Const LOGPIXELSY    As Long = 90
 
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long

Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long

Public Function TwipPixel() As Long
    Dim DskhWnd     As Long
    Dim nhDc        As Long
    Dim Bit         As Long
    Dim nWidth      As Long
    Dim nHeight     As Long

    'デスクトップのハンドル
    DskhWnd = GetDesktopWindow

    'デスクトップのデバイスコンテキストハンドル
    nhDc = GetDC(DskhWnd)

    '画面の横幅
    nWidth = GetDeviceCaps(nhDc, HORZRES)

    '画面の縦幅
    nHeight = GetDeviceCaps(nhDc, VERTRES)

    'ピクセル当たりのビット数
    Bit = GetDeviceCaps(nhDc, BITSPIXEL)

    TwipPixel = CLng(1440 / GetDeviceCaps(nhDc, LOGPIXELSX))

End Function

Public Function isSUTI(ByVal strVal As String) As Long
    Dim SutiDic         As Dictionary
    Dim I               As Long
    Dim Res             As Boolean

    If Len(strVal) = 0 Then
        isSUTI = False
        Exit Function
    End If

    Set SutiDic = New Dictionary
    With SutiDic
        .Add "0", 0
        .Add "1", 1
        .Add "2", 2
        .Add "3", 3
        .Add "4", 4
        .Add "5", 5
        .Add "6", 6
        .Add "7", 7
        .Add "8", 8
        .Add "9", 9
    End With

    Res = True
    For I = 1 To Len(strVal)
        If Not SutiDic.Exists(Mid(strVal, I, 1)) Then
            Res = False
            I = Len(strVal)
        End If
    Next I
    Set SutiDic = Nothing

    isSUTI = Res

End Function

COPY

Option Compare Database
Option Explicit

Public Declare PtrSafe Function CloseWindow Lib "user32" (ByVal hWnd As Long) As Long

'パラメータ
'hWndChild　    子ウィンドウへのハンドル
'hWndNewParent　新しい親ウィンドウへのハンドル
Public Declare PtrSafe Function SetParent Lib "user32" ( _
            ByVal hWndChild As Long, _
            ByVal hWndNewParent As Long) As Long

'パラメータ
'hwnd    ウィンドウへのハンドル
'X       ウィンドウの左側の新しい位置 (ピクセル単位)
'Y       ウィンドウの上部の新しい位置 (ピクセル単位)
'nWidth  ウィンドウの新しい幅 (ピクセル単位)
'nHeight ウィンドウの新しい高さ (ピクセル単位)
'bRepaintウィンドウを再描画するかどうかを示します（1:再描画  0:再描画しない）
Public Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hWnd As Long, _
                                                         ByVal X As Long, _
                                                         ByVal Y As Long, _
                                                         ByVal nWidth As Long, _
                                                         ByVal nHeight As Long, _
                                                         ByVal bRepaint As Long) As Long
'パラメータ
'hWnd       ウィンドウへのハンドル
'hWndInsertAfter Zオーダーで配置されたウィンドウの前にあるウィンドウのハンドル このパラメーターは､ウィンドウハンドルまたは次の値のいずれかでなければなりません
Public Const HWND_TOP = &H0             'ウィンドウをZオーダーの一番上に配置します
Public Const HWND_TOPMOST = -1          'ウィンドウを最上位以外のすべてのウィンドウの上に配置します
'X          クライアント座標での､ウィンドウの左側の新しい位置 (ピクセル単位)
'Y          クライアント座標でのウィンドウ上部の新しい位置 (ピクセル単位)
'cx         ウィンドウの新しい幅 (ピクセル単位)
'cy         ウィンドウの新しい高さ (ピクセル単位)
'uFlags     ウィンドウのサイズ変更および配置フラグ このパラメーターは､以下の値の組み合わせにすることができます
Public Const SWP_NOMOVE = &H2           '現在の位置を保持します（ XおよびYパラメーターを無視します）
Public Const SWP_NOSIZE = &H1           '現在のサイズを保持します（ cxおよびcyパラメーターを無視します）
Public Const SWP_SHOWWINDOW = &H40      'ウィンドウを表示します
Public Declare PtrSafe Function SetWindowPos Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            ByVal hWndInsetAfter As Long, _
            ByVal X As Long, _
            ByVal Y As Long, _
            ByVal cx As Long, _
            ByVal cy As Long, _
            ByVal uFlags As Long _
            ) As Long

'パラメータ
'hWnd       ウィンドウへのハンドル､および間接的に､ウィンドウが属するクラス
'nIndex     取得する値へのゼロベースのオフセット
Public Const GWL_EXSTYLE = -20  '拡張ウィンドウスタイルを取得します
Public Const GWL_STYLE = -16    'ウィンドウスタイルを取得します
Public Const GWL_HWNDPARENT = -8    '親ウィンドウあれば、そのハンドルを取得します
Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long) As Long

'パラメータ
'hWnd       ウィンドウへのハンドル､および間接的に､ウィンドウが属するクラス
'nIndex     取得する値へのゼロベースのオフセット
'dwNewLong  置換値
'GetWindowLongAで得られた値(Val) に対して、最小化ボタンを無効にする場合[dwNewLong = Val And Not WS_MINIMIZEBOX]とする
Public Const WS_OVERLAPPED = &H0        'オーバーラップウィンドウ
Public Const WS_MAXIMIZEBOX = &H10000   '最大化ボタン
Public Const WS_MINIMIZEBOX = &H20000   '最小化ボタン
Public Const WS_SIZEBOX = &H40000       'サイズ変更境界
Public Const WS_THICKFRAME = &H40000    'サイズ変更境界
Public Const WS_SYSMENU = &H80000       'ウィンドウメニュー WS_CAPTIONスタイルも指定する必要があります
Public Const WS_CAPTION = &HC00000      'タイトルバー
Public Const WS_HSCROLL = &H100000      '水平スクロールバー
Public Const WS_VSCROLL = &H200000      '垂直スクロールバー
Public Const WS_BORDER = &H800000       '境界線
Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) As Long

ウィンドの設定をするAPI32

COPY

Option Compare Database
Option Explicit

Public Declare PtrSafe Function CloseWindow Lib "user32" (ByVal hWnd As Long) As Long

'パラメータ
'hWndChild　    子ウィンドウへのハンドル
'hWndNewParent　新しい親ウィンドウへのハンドル
Public Declare PtrSafe Function SetParent Lib "user32" ( _
            ByVal hWndChild As Long, _
            ByVal hWndNewParent As Long) As Long

'パラメータ
'hwnd    ウィンドウへのハンドル
'X       ウィンドウの左側の新しい位置 (ピクセル単位)
'Y       ウィンドウの上部の新しい位置 (ピクセル単位)
'nWidth  ウィンドウの新しい幅 (ピクセル単位)
'nHeight ウィンドウの新しい高さ (ピクセル単位)
'bRepaintウィンドウを再描画するかどうかを示します（1:再描画  0:再描画しない）
Public Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hWnd As Long, _
                                                         ByVal X As Long, _
                                                         ByVal Y As Long, _
                                                         ByVal nWidth As Long, _
                                                         ByVal nHeight As Long, _
                                                         ByVal bRepaint As Long) As Long
'パラメータ
'hWnd       ウィンドウへのハンドル
'hWndInsertAfter Zオーダーで配置されたウィンドウの前にあるウィンドウのハンドル このパラメーターは､ウィンドウハンドルまたは次の値のいずれかでなければなりません
Public Const HWND_TOP = &H0             'ウィンドウをZオーダーの一番上に配置します
Public Const HWND_TOPMOST = -1          'ウィンドウを最上位以外のすべてのウィンドウの上に配置します
'X          クライアント座標での､ウィンドウの左側の新しい位置 (ピクセル単位)
'Y          クライアント座標でのウィンドウ上部の新しい位置 (ピクセル単位)
'cx         ウィンドウの新しい幅 (ピクセル単位)
'cy         ウィンドウの新しい高さ (ピクセル単位)
'uFlags     ウィンドウのサイズ変更および配置フラグ このパラメーターは､以下の値の組み合わせにすることができます
Public Const SWP_NOMOVE = &H2           '現在の位置を保持します（ XおよびYパラメーターを無視します）
Public Const SWP_NOSIZE = &H1           '現在のサイズを保持します（ cxおよびcyパラメーターを無視します）
Public Const SWP_SHOWWINDOW = &H40      'ウィンドウを表示します
Public Declare PtrSafe Function SetWindowPos Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            ByVal hWndInsetAfter As Long, _
            ByVal X As Long, _
            ByVal Y As Long, _
            ByVal cx As Long, _
            ByVal cy As Long, _
            ByVal uFlags As Long _
            ) As Long

'パラメータ
'hWnd       ウィンドウへのハンドル､および間接的に､ウィンドウが属するクラス
'nIndex     取得する値へのゼロベースのオフセット
Public Const GWL_EXSTYLE = -20  '拡張ウィンドウスタイルを取得します
Public Const GWL_STYLE = -16    'ウィンドウスタイルを取得します
Public Const GWL_HWNDPARENT = -8    '親ウィンドウあれば、そのハンドルを取得します
Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long) As Long

'パラメータ
'hWnd       ウィンドウへのハンドル､および間接的に､ウィンドウが属するクラス
'nIndex     取得する値へのゼロベースのオフセット
'dwNewLong  置換値
'GetWindowLongAで得られた値(Val) に対して、最小化ボタンを無効にする場合[dwNewLong = Val And Not WS_MINIMIZEBOX]とする
Public Const WS_OVERLAPPED = &H0        'オーバーラップウィンドウ
Public Const WS_MAXIMIZEBOX = &H10000   '最大化ボタン
Public Const WS_MINIMIZEBOX = &H20000   '最小化ボタン
Public Const WS_SIZEBOX = &H40000       'サイズ変更境界
Public Const WS_THICKFRAME = &H40000    'サイズ変更境界
Public Const WS_SYSMENU = &H80000       'ウィンドウメニュー WS_CAPTIONスタイルも指定する必要があります
Public Const WS_CAPTION = &HC00000      'タイトルバー
Public Const WS_HSCROLL = &H100000      '水平スクロールバー
Public Const WS_VSCROLL = &H200000      '垂直スクロールバー
Public Const WS_BORDER = &H800000       '境界線
Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) As Long

IMEの設定をするAPI32

COPY

Option Compare Database
Option Explicit

'構文C++:
'HIMC ImmGetContext(IN HWND);
'パラメータ　HWND 入力コンテキストを取得するウィンドウのハンドル
'戻り値 入力コンテキストのハンドル
Public Declare PtrSafe Function ImmGetContext Lib "imm32.dll" (ByVal hWnd As Long) As Long

'構文C++:
'BOOL ImmReleaseContext(IN HWND, IN HIMC);
'パラメーター
'hWnd 入力コンテキストが以前に取得されたウィンドウのハンドル
'hImc 入力コンテキストのハンドル
'戻り値
'成功した場合はゼロ以外の値を返し､そうでない場合は0を返します
Public Declare PtrSafe Function ImmReleaseContext Lib "imm32.dll" (ByVal hWnd As Long, ByVal hIMC As Long) As Long

'構文C++:
'BOOL ImmSetOpenStatus(IN HIMC, IN BOOL);
'パラメーター
'hImc 入力コンテキストのハンドル｡
'BOOL IMEを開く場合はTRUE､閉じる場合はFALSE
'戻り値
'成功した場合､ゼロ以外の値を返します
Public Declare PtrSafe Function ImmSetOpenStatus Lib "imm32.dll" (ByVal hIMC As Long, ByVal bool As Long) As Long

'構文C++:
'BOOL ImmGetOpenStatus(IN HIMC);
'パラメーター
'hImc 入力コンテキストのハンドル｡
'戻り値
'IMEが開いている場合はゼロ以外の値を返し､それ以外の場合は0を返します
Public Declare PtrSafe Function ImmGetOpenStatus Lib "imm32.dll" (ByVal hIMC As Long) As Long

子帳票フォーム[選択]のレコードの選択プロシージャ

Yes/No型のコントロール名[タックシール]をクリック

子帳票フォーム

この例では、帳票フォームをサブフォームをしていません。子フォームとしてセクション[詳細]の中で描画します。

COPY

Option Compare Database
Option Explicit

Private Sub タックシール_Click()

    DoCmd.RunCommand acCmdSelectRecord

End Sub

タックシールの印刷プロシージャ

使用済みの枚数処理

枚数処理

使用済み分、レコードの進行を止め、非表示印刷する。1ページ12枚のタックシールなので12レコードが進んだら改ページをする

COPY

'****************************************************************
'コントロール郵便番号(Zip)住所(Address1,Address2)名前(Name1,Name2,Name3)
'を配置した1ページ12シートを想定したタックシールの印刷
'****************************************************************
Option Compare Database
Option Explicit

Private SpaceCount      As Long
Private iCount          As Long

Private Sub Report_Open(Cancel As Integer)

    '****************************************************************
    'Load時では、変更できません
    '****************************************************************
    Me.RecordSource = "SELECT A.* FROM TABLE AS A WHERE (A.C1 >= 1);"

    SpaceCount = Nz(Me.OpenArgs, 0)

    iCount = 0

End Sub

Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)

    iCount = iCount + 1

    If SpaceCount > 0 Then
        If iCount <= SpaceCount Then
            '使用済のシールの枚数を想定しています
            'SpaceCountの数だけレコードの進行を止めます
            Me.NextRecord = False
            '非表示にして印字はありませんが、詳細セクションの進行はあります
            CtrlVisi False
        Else
            'レコードを進めます
            Me.NextRecord = True
            '表示にして印刷します
            CtrlVisi True
        End If
    Else
        Me.NextRecord = True
        CtrlVisi True
    End If

    '****************************************************************
    '改ページをオートにするとページが変わる毎にiCountが1多くなります
    'これは、詳細セクションを描画するときにページに収まるか判定を行うため、
    '判定の詳細セクション1が加算されるからです
    '****************************************************************
    '判定の前に改ページします
    Me.改ページ.Visible = (iCount Mod 12 = 0)

End Sub

Private Sub CtrlVisi(BO As Boolean)

    Me.Zip.Visible = BO
    Me.Address1.Visible = BO
    Me.Address2.Visible = BO
    Me.Name1.Visible = BO
    Me.Name2.Visible = BO
    Me.Name3.Visible = BO

End Sub