140613-vba

 以前のAccessはフォームにボタンなどのオブジェクトの配置する時にウィザードを使って配置するとイベントが「イベントプロシージャー」であるVBAで作られたのですが、最近はマクロで作られます。

 マクロで作られた内容はVBAに変換することができるのですが、下記にフォームのボタンをウィザードで作ったマクロをVBAに変換した場合のプログラムを掲載しておきます。

「なんでそんなことを?」

と、思われるかもしれませんが、明記しておくと私は何かと便利なので、せっかくならシェア(共有)できるように書いておこうと思って(^^ゞ

下記プログラムはボタンをウィザードで作った場合のVBAです。それ以外のオブジェクト(テキストボックス、コンボボックスなど)は書いていません。並び順はあいうえお順です。また、プログラムは「エラー処理コードを使いする」「コメントを含める」のチェックボックスをONにしています。Accessのバージョンは2013です。

目次

アプリの終了

'------------------------------------------------------------
' アプリの終了
'
'------------------------------------------------------------
Function アプリの終了()
On Error GoTo アプリの終了_Err

    DoCmd.Quit acPrompt


アプリの終了_Exit:
    Exit Function

アプリの終了_Err:
    MsgBox Error$
    Resume アプリの終了_Exit

End Function

オートダイヤラー

'------------------------------------------------------------
' オートダイヤラー
'
'------------------------------------------------------------
Function オートダイヤラー()
On Error GoTo オートダイヤラー_Err

    On Error Resume Next
    DoCmd.GoToControl Screen.PreviousControl.Name
    DoCmd.RunCommand acCmdAutoDial


オートダイヤラー_Exit:
    Exit Function

オートダイヤラー_Err:
    MsgBox Error$
    Resume オートダイヤラー_Exit

End Function

カレントフォームの印刷

'------------------------------------------------------------
' カレントフォームの印刷
'
'------------------------------------------------------------
Function カレントフォームの印刷()
On Error GoTo カレントフォームの印刷_Err

    DoCmd.RunCommand acCmdPrint


カレントフォームの印刷_Exit:
    Exit Function

カレントフォームの印刷_Err:
    MsgBox Error$
    Resume カレントフォームの印刷_Exit

End Function

クエリの実行

'------------------------------------------------------------
' クエリの実行
'
'------------------------------------------------------------
Function クエリの実行()
On Error GoTo クエリの実行_Err

    DoCmd.OpenQuery "(クエリ名)", acViewNormal, acEdit


クエリの実行_Exit:
    Exit Function

クエリの実行_Err:
    MsgBox Error$
    Resume クエリの実行_Exit

End Function

テーブルの印刷

'------------------------------------------------------------
' テーブルの印刷
'
'------------------------------------------------------------
Function テーブルの印刷()
On Error GoTo テーブルの印刷_Err

    DoCmd.SelectObject acTable, "(テーブル名)", True
    DoCmd.RunCommand acCmdPrint
    DoCmd.SelectObject acForm, Screen.ActiveForm.Name, False


テーブルの印刷_Exit:
    Exit Function

テーブルの印刷_Err:
    MsgBox Error$
    Resume テーブルの印刷_Exit

End Function

フィルターの実行

'------------------------------------------------------------
' フィルターの実行
'
'------------------------------------------------------------
Function フィルターの実行()
On Error GoTo フィルターの実行_Err

    DoCmd.RunCommand acCmdDeleteRecord


フィルターの実行_Exit:
    Exit Function

フィルターの実行_Err:
    MsgBox Error$
    Resume フィルターの実行_Exit

End Function

フォームの印刷

'------------------------------------------------------------
' フォームの印刷
'
'------------------------------------------------------------
Function フォームの印刷()
On Error GoTo フォームの印刷_Err

    DoCmd.SelectObject acForm, "(フォーム名)", True
    DoCmd.RunCommand acCmdPrint
    DoCmd.SelectObject acForm, Screen.ActiveForm.Name, False


フォームの印刷_Exit:
    Exit Function

フォームの印刷_Err:
    MsgBox Error$
    Resume フォームの印刷_Exit

End Function

フォームを開く

'------------------------------------------------------------
' フォームを開く
'
'------------------------------------------------------------
Function フォームを開く()
On Error GoTo フォームを開く_Err

    DoCmd.OpenForm "(フォーム名)", acNormal, "", "", , acNormal


フォームを開く_Exit:
    Exit Function

フォームを開く_Err:
    MsgBox Error$
    Resume フォームを開く_Exit

End Function

フォームを閉じる

'------------------------------------------------------------
' フォームを閉じる
'
'------------------------------------------------------------
Function フォームを閉じる()
On Error GoTo フォームを閉じる_Err

    DoCmd.Close , ""


フォームを閉じる_Exit:
    Exit Function

フォームを閉じる_Err:
    MsgBox Error$
    Resume フォームを閉じる_Exit

End Function

マクロの実行

'------------------------------------------------------------
' マクロの実行
'
'------------------------------------------------------------
Function マクロの実行()
On Error GoTo マクロの実行_Err

    DoCmd.RunMacro "(マクロ名)", , ""


マクロの実行_Exit:
    Exit Function

マクロの実行_Err:
    MsgBox Error$
    Resume マクロの実行_Exit

End Function

レコードの印刷

'------------------------------------------------------------
' レコードの印刷
'
'------------------------------------------------------------
Function レコードの印刷()
On Error GoTo レコードの印刷_Err

    DoCmd.RunCommand acCmdSelectRecord
    DoCmd.RunCommand acCmdPrintSelection


レコードの印刷_Exit:
    Exit Function

レコードの印刷_Err:
    MsgBox Error$
    Resume レコードの印刷_Exit

End Function

レコードの検索

'------------------------------------------------------------
' レコードの検索
'
'------------------------------------------------------------
Function レコードの検索()
On Error GoTo レコードの検索_Err

    With CodeContextObject
        On Error Resume Next
        DoCmd.GoToControl Screen.PreviousControl.Name
        Err.Clear
        DoCmd.RunCommand acCmdFind
        If (.MacroError <> 0) Then
            Beep
            MsgBox .MacroError.Description, vbOKOnly, ""
        End If
    End With


レコードの検索_Exit:
    Exit Function

レコードの検索_Err:
    MsgBox Error$
    Resume レコードの検索_Exit

End Function

レコードの削除

'------------------------------------------------------------
' レコードの削除
'
'------------------------------------------------------------
Function レコードの削除()
On Error GoTo レコードの削除_Err

    With CodeContextObject
        On Error Resume Next
        DoCmd.GoToControl Screen.PreviousControl.Name
        Err.Clear
        If (Not .Form.NewRecord) Then
            DoCmd.RunCommand acCmdDeleteRecord
        End If
        If (.Form.NewRecord And Not .Form.Dirty) Then
            Beep
        End If
        If (.Form.NewRecord And .Form.Dirty) Then
            DoCmd.RunCommand acCmdUndo
        End If
        If (.MacroError <> 0) Then
            Beep
            MsgBox .MacroError.Description, vbOKOnly, ""
        End If
    End With


レコードの削除_Exit:
    Exit Function

レコードの削除_Err:
    MsgBox Error$
    Resume レコードの削除_Exit

End Function

レコードの追加

'------------------------------------------------------------
' レコードの追加
'
'------------------------------------------------------------
Function レコードの追加()
On Error GoTo レコードの追加_Err

    With CodeContextObject
        On Error Resume Next
        DoCmd.GoToRecord , "", acNewRec
        If (.MacroError <> 0) Then
            Beep
            MsgBox .MacroError.Description, vbOKOnly, ""
        End If
    End With


レコードの追加_Exit:
    Exit Function

レコードの追加_Err:
    MsgBox Error$
    Resume レコードの追加_Exit

End Function

レコードの複製

'------------------------------------------------------------
' レコードの複製
'
'------------------------------------------------------------
Function レコードの複製()
On Error GoTo レコードの複製_Err

    With CodeContextObject
        On Error Resume Next
        DoCmd.RunCommand acCmdSelectRecord
        If (.MacroError = 0) Then
            DoCmd.RunCommand acCmdCopy
        End If
        If (.MacroError = 0) Then
            DoCmd.RunCommand acCmdRecordsGoToNew
        End If
        If (.MacroError = 0) Then
            DoCmd.RunCommand acCmdSelectRecord
        End If
        If (.MacroError = 0) Then
            DoCmd.RunCommand acCmdPaste
        End If
        If (.MacroError <> 0) Then
            Beep
            MsgBox .MacroError.Description, vbOKOnly, ""
        End If
    End With


レコードの複製_Exit:
    Exit Function

レコードの複製_Err:
    MsgBox Error$
    Resume レコードの複製_Exit

End Function

レコードの保存

'------------------------------------------------------------
' レコードの保存
'
'------------------------------------------------------------
Function レコードの保存()
On Error GoTo レコードの保存_Err

    With CodeContextObject
        On Error Resume Next
        DoCmd.RunCommand acCmdSaveRecord
        If (.MacroError <> 0) Then
            Beep
            MsgBox .MacroError.Description, vbOKOnly, ""
        End If
    End With


レコードの保存_Exit:
    Exit Function

レコードの保存_Err:
    MsgBox Error$
    Resume レコードの保存_Exit

End Function

レコードを元に戻す

'------------------------------------------------------------
' レコードを元に戻す
'
'------------------------------------------------------------
Function レコードを元に戻す()
On Error GoTo レコードを元に戻す_Err

    With CodeContextObject
        On Error Resume Next
        DoCmd.RunCommand acCmdUndo
        If (.MacroError <> 0) Then
            Beep
            MsgBox .MacroError.Description, vbOKOnly, ""
        End If
    End With


レコードを元に戻す_Exit:
    Exit Function

レコードを元に戻す_Err:
    MsgBox Error$
    Resume レコードを元に戻す_Exit

End Function

レポートのプレビュー

'------------------------------------------------------------
' レポートのプレビュー
'
'------------------------------------------------------------
Function レポートのプレビュー()
On Error GoTo レポートのプレビュー_Err

    DoCmd.OpenReport "(レポート名)", acViewPreview, "", "", acNormal


レポートのプレビュー_Exit:
    Exit Function

レポートのプレビュー_Err:
    MsgBox Error$
    Resume レポートのプレビュー_Exit

End Function

レポートの印刷

'------------------------------------------------------------
' レポートの印刷
'
'------------------------------------------------------------
Function レポートの印刷()
On Error GoTo レポートの印刷_Err

    DoCmd.OpenReport "(レポート名)", acViewPreview, "", "", acNormal
    DoCmd.RunCommand acCmdPrint


レポートの印刷_Exit:
    Exit Function

レポートの印刷_Err:
    MsgBox Error$
    Resume レポートの印刷_Exit

End Function

レポートの送信

'------------------------------------------------------------
' レポートの送信
'
'------------------------------------------------------------
Function レポートの送信()
On Error GoTo レポートの送信_Err

    DoCmd.SendObject acReport, "(レポート名)", "", "", "", "", "", "", True, ""


レポートの送信_Exit:
    Exit Function

レポートの送信_Err:
    MsgBox Error$
    Resume レポートの送信_Exit

End Function

レポートをファイルに出力

'------------------------------------------------------------
' レポートをファイルに出力
'
'------------------------------------------------------------
Function レポートをファイルに出力()
On Error GoTo レポートをファイルに出力_Err

    DoCmd.OutputTo acOutputReport, "(レポート名)", "", "", False, "", , acExportQualityPrint


レポートをファイルに出力_Exit:
    Exit Function

レポートをファイルに出力_Err:
    MsgBox Error$
    Resume レポートをファイルに出力_Exit

End Function

レポートを開く

'------------------------------------------------------------
' レポートを開く
'
'------------------------------------------------------------
Function レポートを開く()
On Error GoTo レポートを開く_Err

    DoCmd.OpenReport "(レポート名)", acViewReport, "", "", acNormal


レポートを開く_Exit:
    Exit Function

レポートを開く_Err:
    MsgBox Error$
    Resume レポートを開く_Exit

End Function

再表示

'------------------------------------------------------------
' 再表示
'
'------------------------------------------------------------
Function 再表示()
On Error GoTo 再表示_Err

    DoCmd.RunCommand acCmdRefresh


再表示_Exit:
    Exit Function

再表示_Err:
    MsgBox Error$
    Resume 再表示_Exit

End Function

最後のレコード

'------------------------------------------------------------
' 最後のレコード
'
'------------------------------------------------------------
Function 最後のレコード()
On Error GoTo 最後のレコード_Err

    DoCmd.GoToRecord , "", acLast


最後のレコード_Exit:
    Exit Function

最後のレコード_Err:
    MsgBox Error$
    Resume 最後のレコード_Exit

End Function

次のレコード

'------------------------------------------------------------
' 次のレコード
'
'------------------------------------------------------------
Function 次のレコード()
On Error GoTo 次のレコード_Err

    With CodeContextObject
        On Error Resume Next
        DoCmd.GoToRecord , "", acNext
        If (.MacroError <> 0) Then
            Beep
            MsgBox .MacroError.Description, vbOKOnly, ""
        End If
    End With


次のレコード_Exit:
    Exit Function

次のレコード_Err:
    MsgBox Error$
    Resume 次のレコード_Exit

End Function

次を検索

'------------------------------------------------------------
' 次を検索
'
'------------------------------------------------------------
Function 次を検索()
On Error GoTo 次を検索_Err

    DoCmd.FindNext


次を検索_Exit:
    Exit Function

次を検索_Err:
    MsgBox Error$
    Resume 次を検索_Exit

End Function

先頭のレコード

'------------------------------------------------------------
' 先頭のレコード
'
'------------------------------------------------------------
Function 先頭のレコード()
On Error GoTo 先頭のレコード_Err

    DoCmd.GoToRecord , "", acFirst


先頭のレコード_Exit:
    Exit Function

先頭のレコード_Err:
    MsgBox Error$
    Resume 先頭のレコード_Exit

End Function

前のレコード

'------------------------------------------------------------
' 前のレコード
'
'------------------------------------------------------------
Function 前のレコード()
On Error GoTo 前のレコード_Err

    With CodeContextObject
        On Error Resume Next
        DoCmd.GoToRecord , "", acPrevious
        If (.MacroError <> 0) Then
            Beep
            MsgBox .MacroError.Description, vbOKOnly, ""
        End If
    End With


前のレコード_Exit:
    Exit Function

前のレコード_Err:
    MsgBox Error$
    Resume 前のレコード_Exit

End Function

速効! ビジネスPC Access マクロ&VBA 職場ですぐに役立つテクニック&サンプル [Access2013/2010/2007対応]

著者/訳者:結城 圭介

出版社:技術評論社( 2014-06-10 )

定価:

Amazon価格:¥ 3,456

大型本 ( 320 ページ )

ISBN-10 : 4774165158

ISBN-13 : 9784774165158