アクセスVBAコード覚書２ Private Sub アプリケーションの終了_Click() DoCmd.Quit End Sub Private Sub フォームを閉じる_Click() DoCmd.Close End Sub Private Sub モードレス_Click() DoCmd.OpenForm "フォーム表示１", acNormal End Sub Private Sub Form_Load() Me.Modal = True 'モーダルを真に設定 End Sub 先頭レコード　　 BOF = Begin of File 最後のレコード　EOF = End of File Private Sub テーブルを開く_Click() Dim db As Database ' データベース変数の宣言 Dim rs As Recordset ' レコードセット変数の宣言 Set db = CurrentDb ' カレントなデータベースを設定 Set rs = db.OpenRecordset(テーブル名, dbOpenDynaset) 'ダイナセットタイプで開く Me.RecordSource = テーブル名 ' フォームのプロパティにテーブル名を設定 rs.Close db.Close End Sub Private Sub 次のレコードに_Click() rs.MoveNext DBのデータをセット End Sub Private Sub 前のレコードに_Click() rs.MovePrevious DBのデータをセット End Sub Private Sub 先頭のレコードに_Click() rs.MoveFirst DBのデータをセット End Sub Private Sub 最後のレコードに_Click() rs.MoveLast DBのデータをセット End Sub Private Sub レコードの編集_Click() Me.AllowEdits = True End Sub Private Sub レコードを編集する_Click() rs.Edit ' レコードセットが編集できるようにする rs!頭文字 = cur頭文字 ' カレントレコード表示欄の内容をレコードセットに設定 rs!本文 = cur本文 rs.Update ' レコードセットを更新する End Sub Private Sub レコードの保存_Click() Me.AllowEdits = False MsgBox "レコードを保存しました。" End Sub Private Sub Form_AfterUpdate()　'フォームを閉じた時にも保存するように設定する。 Me.AllowEdits = False MsgBox "レコードを保存しました。" End Sub Private Sub レコードを削除する_Click() rs.Delete End Sub Private Sub レコードを検索する_Click() rs.Index = "ID" ' インデックスにIDフィールドを指定 rs.Seek 検索条件, 検索キー ' インデックスによる連作を実行 DBのデータをセット End Sub Private Sub DBのデータをセット() curID = rs!ID ' ID欄を代入 cur頭文字 = rs!頭文字 ' 頭文字を代入 cur本文 = rs!本文 ' 本文を代入 End Sub Private Sub 先頭から後方に検索する_Click() rs.FindFirst 検索条件 DBのデータをセット End Sub Private Sub 最後から前方に検索する_Click() rs.FindLast 検索条件 DBのデータをセット End Sub Private Sub カレントから後方に検索する_Click() rs.FindNext 検索条件 DBのデータをセット End Sub Private Sub カレントから前方に検索する_Click() rs.FindPrevious 検索条件 DBのデータをセット End Sub Private Sub レコードを抽出する_Click() rs.Filter = 抽出条件 End Sub Private Sub 抽出レコードセットを表示する_Click() Set rs = rs.OpenRecordset() ' 抽出したレコードセット変数を設定 抽出件数 = rs.RecordCount DBのデータをセット End Sub Private Sub レコードを並べ替える_Click() rs.Sort = 並べ替え順序 データ表示の初期化 End Sub Private Sub 並べ替え結果を表示_Click() Set rs = rs.OpenRecordset() DBのデータをセット End Sub マクロをVBコードに一括変換する １、フォームをデザインビューで表示 ２、メニューのツール＞マクロ＞フォームマクロをVisual　Ｂａｓｉｃに変換をクリック エラー処理コードは自動的に追加される。 検索用コンボボックスがデータ移動で更新されるようにする。 Private Sub Form_Current() 検索用 コンボ47 = 顧客情報ID End Sub オプショングループを選択することで抽出の実行をする。 Private Sub フィルタオプション１_AfterUpdate() If フィルタオプション１ = 2 Then Me.Filter = "都道府県 = '東京都'" Me.FilterOn = True Else Me.FilterOn = fale End If End Sub もし敬称のテキストボックスが空白なら氏名に敬称をつけて表示する Private Sub 氏名_AfterUpdate() If IsNull(敬称) Then 敬称 = 氏名 + "　様" End If End Sub Ctrlキー＋1を押すと都道府県テキストボックスに「東京都」が入力される。KeyCode = 49は１を表し、Shift = 2はCtrlキーを表す。 Private Sub 都道府県_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 49 And Shift = 2 Then 都道府県 = "東京都" End If End Sub 住所入力後保存時に郵便番号をチェックする Private Sub Form_BeforeUpdate(Cancel As Integer) If Not IsNull(住所) And IsNull(郵便番号) Then MsgBox "郵便番号が入力されていません", vbExclamation 郵便番号.SetFocus Cancel = True End If End Sub メッセージの選択で分岐する。 Private Sub Form_BeforeUpdate(Cancel As Integer) Dim mymessage As String Dim mynumber1 As Integer Dim mychoice As Byte If Not IsNull(住所) And IsNull(郵便番号) Then mymessage = "郵便番号が入力されていません、保存しますか？" mynumber1 = vbQuestion + vbOKCancel mychoice = MsgBox(mymessage, mynumber1) If mychoice = vbCancel Then 郵便番号.SetFocus Cancel = True End If End If End Sub フォーカスがコンボボックスに移動した時に背景を白色抜けるとグレーに変更する。 Private Sub コンボ47_Enter() コンボ47.BackColor = 16777215 End Sub Private Sub コンボ47_Exit(Cancel As Integer) コンボ47.BackColor = 12632256 End Sub ユーザー定義関数を作成する Private Function FullName() As String FullName = 氏名 & "(" & シメイ & ")" End Function ユーザー定義関数を作成する Public Function FullAddress() As String If IsNull(氏名) Or IsNull(住所) Then FullAddress = " " Else FullAddress = "〒" & Left(郵便番号, 3) & "-" & Right(郵便番号, 4) & vbNewLine & 都道府県 & 住所 & vbNewLine & 敬称 End If End Function '宣言部分 Option Compare Database '変数の宣言を強制する。 Option Explicit '定数を宣言 Const conAppName = "顧客情報の管理" 引数の設定 'Public Sub DisplayMessage()はじめはこのようになっている。 Public Sub DisplayMessage(strMessage As String) ' 　　　 ↑は変数 ' ' MsgBox "これは重要です。", vbExclamation, conAppName ' ↑のコードを↓のように変更できる。 MsgBox strMessage, vbExclamation, conAppName ' ↑変数なので””は不要 End Sub ユーザー定義関数での引数の設定 Public Function Confirm(strMessage As String) As Boolean ' ↑はTrueかFalseを返す型だと宣言した。 Dim byteChoice As Byte ' ↑変数を宣言 byteChoice = MsgBox(strMessage, vbQuestion + vbOKCancel, conAppName) ' ？+[OK][キャンセル]が表示される　↑はメッセージのタイトルを定数で表示している If byteChoice = vbOK Then Confirm = True Else Confirm = False End If End Function 標準のエラー番号を表示する Private Sub Form_Error(DataErr As Integer, Response As Integer) Debug.Print "エラーコード　＝"; DataErr End Sub オリジナルのエラーを表示する Private Sub Form_Error(DataErr As Integer, Response As Integer) Const conErrFieldRequired = 3314　　　'定数設定 If DataErr = conErrFieldRequired Then DisplayMessage "[氏名]フィールドには必ずデータを入力してください。" Response = acDataErrContinue　　　　'標準エラーメッセージを表示しない設定 Else Response = acDataErrDisplay 'そうでなければ標準のエラーメッセージを表示する End If End Sub エラー番号の意味一覧 定数 値 説明 adErrBoundToCommand 3707 -2146824581 0x800A0E7B Command オブジェクトをソースに持つ Recordset オブジェクトの ActiveConnection プロパティを変更できません。 adErrCannotComplete 3732 -2146824556 0x800A0E94 サーバーは操作を完了できません。 adErrCantChangeConnection 3748 -2146824540 0x800A0EA4 接続が拒否されました。要求された新規接続の特性が現在使用中の特性と異なります。 adErrCantChangeProvider 3220 -2146825068 0X800A0C94 供給されたプロバイダは、すでに使用されているものと異なります。 adErrCantConvertvalue 3724 -2146824564 0x800A0E8C データの値がデータ オーバーフローまたは符号の不一致以外の原因で変換できませんでした。例として、変換によりデータが切り捨てられた場合があげられます。 adErrCantCreate 3725 -2146824563 0x800A0E8D フィールド データ タイプが不明か、プロバイダが操作を実行するのに十分なリソースを持っていなかったため、データの値を設定または取得できません。 adErrCatalogNotSet 3747 -2146824541 0x800A0EA3 操作には有効な ParentCatalog が必要です。 adErrColumnNotOnThisRow 3726 -2146824562 0x800A0E8E レコードはフィールドを含んでいません。 adErrDataConversion 3421 -2146824867 0x800A0D5D 現在の操作に対して、間違った種類の値を使用しています。 adErrDataOverflow 3721 -2146824567 0x800A0E89 データの値がフィールド データ タイプとして表されるには大きすぎます。 adErrDelResOutOfScope 3738 -2146824550 0x800A0E9A 削除されるオブジェクトの URL は現在のレコードの範囲外です。 adErrDenyNotSupported 3750 -2146824538 0x800A0EA6 プロバイダは共有の制限をサポートしていません。 adErrDenyTypeNotSupported 3751 -2146824537 0x800A0EA7 プロバイダは要求された共有の制限をサポートしていません。 adErrFeatureNotAvailable 3251 -2146825037 0x800A0CB3 オブジェクトまたはプロバイダは要求された操作を実行できません。 adErrFieldsUpdateFailed 3749 -2146824539 0x800A0EA5 フィールドの更新に失敗しました。詳細については、各フィールド オブジェクトの [状態] のプロパティを参照してください。 adErrIllegalOperation 3219 -2146825069 0x800A0C93 このコンテキストで操作は許可されていません。 adErrIntegrityViolation 3719 -2146824569 0x800A0E87 データの値がフィールドの整合性制約に違反しています。 adErrInTransaction 3246 -2146825042 0x800A0CAE Connection オブジェクトをトランザクションの途中で明示的に閉じられません。 adErrInvalidArgument 3001 -2146825287 0x800A0BB9 引数が間違った種類、または許容範囲外であるか、競合しています。 adErrInvalidConnection 3709 -2146824579 0x800A0E7D 閉じている、または無効な接続を参照するオブジェクトでの操作は許可されていません。 adErrInvalidParamInfo 3708 -2146824580 0x800A0E7C Parameter オブジェクトが適切に定義されていません。矛盾した、または不完全な情報が提供されました。 adErrInvalidTransaction 3714 -2146824574 0x800A0E82 調整トランザクションが無効であるか、開始していません。 adErrInvalidURL 3729 -2146824559 0x800A0E91 URL に無効な文字が含まれています。URL が正しく入力されているか確認してください。 adErrItemNotFound 3265 -2146825023 0x800A0CC1 要求された名前、または序数に対応する項目がコレクションで見つかりません。 adErrNoCurrentRecord 3021 -2146825267 0x800A0BCD BOF と EOF のいずれかが True になっているか、または現在のレコードが削除されています。要求された操作には、現在のレコードが必要です。 adErrNotExecuting 3715 -2146824573 0x800A0E83 実行していない間に操作を行うことはできません。 adErrNotReentrant 3710 -2146824578 0x800A0E7E イベント処理中に操作を行うことはできません。 adErrObjectClosed 3704 -2146824584 0x800A0E78 オブジェクトが閉じている場合は、操作は許可されません。 adErrObjectInCollection 3367 -2146824921 0x800A0D27 オブジェクトは既にコレクションに存在します。追加できません。 adErrObjectNotSet 3420 -2146824868 0x800A0D5C オブジェクトは、もう有効ではありません。 adErrObjectOpen 3705 -2146824583 0x800A0E79 オブジェクトが開いている場合は、操作は許可されません。 adErrOpeningFile 3002 -2146825286 0x800A0BBA ファイルを開けませんでした。 adErrOperationCancelled 3712 -2146824576 0x800A0E80 ユーザーにより操作が取り消されました。 adErrOutOfSpace 3734 -2146824554 0x800A0E96 操作を実行できません。プロバイダによって十分な格納領域が確保できません。 adErrPermissionDenied 3720 -2146824568 0x800A0E88 権限不足のためフィールドの書き込みはできません。 adErrPropConflicting 3742 -2146824546 0x800A0E9E プロパティの値が、関連するプロパティと競合します。 adErrPropInvalidColumn 3739 -2146824549 0x800A0E9B プロパティは指定されたフィールドに適用されません。 adErrPropInvalidOption 3740 -2146824548 0x800A0E9C プロパティの属性が無効です。 adErrPropInvalidValue 3741 -2146824547 0x800A0E9D プロパティの値が無効です。値が正しく入力されているか確認してください。 adErrPropNotAllSettable 3743 -2146824545 0x800A0E9F プロパティは読み取り専用のため、設定できません。 adErrPropNotSet 3744 -2146824544 0x800A0EA0 オプションのプロパティの値が設定されていません。 adErrPropNotSettable 3745 -2146824543 0x800A0EA1 読み取り専用のプロパティの値が設定されていませんでした。 adErrPropNotSupported 3746 -2146824542 0x800A0EA2 プロバイダはプロパティをサポートしていません。 adErrProviderFailed 3000 -2146825288 0x800A0BB8 プロバイダは要求された操作に失敗しました。 adErrProviderNotFound 3706 -2146824582 0x800A0E7A プロバイダが見つかりません。正しくインストールされていない可能性があります。 adErrReadFile 3003 -2146825285 0x800A0BBB ファイルを読み込めませんでした。 adErrResourceExists 3731 -2146824557 0x800A0E93 コピー操作を実行できません。あて先の URL によって名前を付けられたオブジェクトがすでに存在します。オブジェクトを置き換えるためには adCopyOverwrite を指定してください。 adErrResourceLocked 3730 -2146824558 0x800A0E92 指定された URL によって表されたオブジェクトは 1 つ以上のほかのプロセスによってロックされています。プロセスが終了するまで待って、操作を再度実行してください。 adErrResourceOutOfScope 3735 -2146824553 0x800A0E97 ソースまたはあて先の URL が現在のレコードの範囲外です。 adErrSchemaViolation 3722 -2146824566 0x800A0E8A データの値がデータ タイプまたはフィールドの制約と競合しています。 adErrSignMismatch 3723 -2146824565 0x800A0E8B データの値は署名されましたが、プロバイダによって使用されるフィールド データ タイプは未署名だったため、変換に失敗しました。 adErrStillConnecting 3713 -2146824575 0x800A0E81 非同期的な接続中に操作を行うことはできません。 adErrStillExecuting 3711 -2146824577 0x800A0E7F 非同期的な実行中に操作を行うことはできません。 adErrTreePermissionDenied 3728 -2146824560 0x800A0E90 ツリーまたはサブツリーにアクセスするには許可が不十分です。 adErrUnavailable 3736 -2146824552 0x800A0E98 操作の完了に失敗し、状態は利用できません。フィールドが使用できないか操作が実行されなかった可能性があります。 adErrUnsafeOperation 3716 -2146824572 0x800A0E84 このコンピュータの安全性の設定により、ほかのドメインのデータ ソースへのアクセスは禁止されています。 adErrURLDoesNotExist 3727 -2146824561 0x800A0E8F ソース URL またはあて先の URL の親が存在しません。 adErrURLNamedRowDoesNotExist 3737 -2146824551 0x800A0E99 この URL によって名前を付けられたレコードが存在しません。 adErrVolumeNotFound 3733 -2146824555 0x800A0E95 プロバイダは URL によって指定された記憶装置を見つけられません。URL が正しく入力されているか確認してください。 adErrWriteFile 3004 -2146825284 0x800A0BBC ファイルへ書き込めませんでした。 adWrnSecurityDialog 3717 -2146824571 0x800A0E85 内部使用のため用意されています。使用できません。 adWrnSecurityDialogHeader 3718 -2146824570 0x800A0E86 内部使用のため用意されています。使用できません Private Sub リスト0_AfterUpdate() 'リストボックスが更新したら、レコードの表示ボタンを選択可能にする レコードの表示.Enabled = True End Sub Private Sub リスト0_DblClick(Cancel As Integer) 'リスト0が空白でない時にはレコードの表示ボタンをクリックするコードを実行する If Not IsNull(リスト0) Then レコードの表示_Click End Sub Private Sub レコードの表示_Click() 'リスト一覧からレコードを選択した後にダイアログボックスを閉じる Dim rst As Recordset 'レコードセットを購読者フォームのレコード数を　rst　にセットする Set rst = Forms!購読者.RecordsetClone '選択された購読者のレコードを検索する rst.FindFirst "購読者ID = " & リスト0 'レコードを移動するために、フォームのブックマークプロパティにretのブックマークを代入設定する Forms!購読者.Bookmark = rst.Bookmark 'レコードの選択フォームを閉じる DoCmd.Close acForm, "レコードの選択" End Sub 宛名ラベル印刷 Private Sub ラベルプレビュー_Click() '抽出した宛名ラベルレポートを表示してダイアログボックスを閉じる。 'レポート名とフィルター条件名を変数に定義 Dim strFilter As String, strReportName As String 'オプションボタンで選択する Select Case 郵送内容 Case 1 '全員印刷 strFilter = "支払い有効期限 >= Date()" Case 2 '今後３ヶ月以内に期限が切れる人だけ印刷 strFilter = "支払い有効期限 >= Date() And 支払い有効期限 < Date() + 90" Case 3 '過去３ヶ月以内に期限が切れている人だけ印刷 strFilter = "支払い有効期限 >= Date() And 支払い有効期限 > Date() - 90" End Select 'ラベルの大きさ設定 If ラベル = 1 Then strReportName = "宛名ラベル小" Else strReportName = "宛名ラベル大" End If 'フィルター条件とレポート名を設定してレポートを開いてプリントプレビューして印刷する DoCmd.OpenReport strReportName, acViewPreview, , strFilter '宛名ラベルダイアログフォームを閉じる DoCmd.Close acForm, "宛名ラベルダイアログ" End Sub Private Sub ラベル印刷_Click() '抽出した宛名ラベルレポートを表示してダイアログボックスを閉じる。 'レポート名とフィルター条件名を変数に定義 Dim strFilter As String, strReportName As String 'オプションボタンで選択する Select Case 郵送内容 Case 1 '全員印刷 strFilter = "支払い有効期限 >= Date()" Case 2 '今後３ヶ月以内に期限が切れる人だけ印刷 strFilter = "支払い有効期限 >= Date() And 支払い有効期限 < Date() + 90" Case 3 '過去３ヶ月以内に期限が切れている人だけ印刷 strFilter = "支払い有効期限 >= Date() And 支払い有効期限 > Date() - 90" End Select 'ラベルの大きさ設定 If ラベル = 1 Then strReportName = "宛名ラベル小" Else strReportName = "宛名ラベル大" End If 'フィルター条件とレポート名を設定してレポートを開いてプリントプレビューして印刷する DoCmd.OpenReport strReportName, acViewNormal, , strFilter '宛名ラベルダイアログフォームを閉じる DoCmd.Close acForm, "宛名ラベルダイアログ" End Sub フォームからポップアップフォームを開く場合にはウィザードをオンにしておいてから、コマンドボタンを クリック選択し、ウィザードでリンクするフィールドを選択してリンクをはってポップアップフォームを開く。 カレントレコードのデータのみがサブフォームに表示される。 ウィザードで書かれたコード↓ Private Sub 支払い履歴__P__Click() On Error GoTo Err_支払い履歴__P__Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "支払い履歴" stLinkCriteria = "[購読者ID]=" & Me![購読者ID] DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_支払い履歴__P__Click: Exit Sub Err_支払い履歴__P__Click: MsgBox Err.Description Resume Exit_支払い履歴__P__Click End Sub 呼び出し側フォームのプロパティにレコード移動時イベントに設定する Private Sub Form_Current() 'ポップアップフォームと呼び出しフォームを連動さす。 If IsOpen("支払い履歴") Then Forms!支払い履歴.Filter = "購読者ID=" & Nz(購読者ID, 0) End If End Sub ポップアップフォームが開かれるときにフォームのデータを連動さす Private Sub Form_Open(Cancel As Integer) If IsOpen("購読者") Then 購読者ID.DefaultValue = Forms!購読者!購読者ID End If End Sub 自動的に他のフォームのデータを更新さす。 Private Sub Form_AfterUpdate() '開いている他のフォームのデータを更新する If IsOpen("購読者") Then Forms!購読者.Refresh End If If IsOpen("支払い履歴") Then Forms!支払い履歴.Requery End If End Sub 標準モジュール内に事前にユーザー定義関数を設定しておく必要がある。 Public Function IsOpen(ByVal strFormName As String) As Boolean ' 指定したフォームがフォームビューで開いていればTrueを返す。 Const conDesignView = 0 Const conObjStateClosed = 0 IsOpen = False If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> conObjStateClosed Then If Forms(strFormName).CurrentView <> conDesignView Then IsOpen = True End If End If End Function