| Access VBA |
フォーム
| フォーム | |
 コンボボックスの値を参照（テキストボックスで） |
|
| Private Sub CMB_種別_AfterUpdate() If Not IsNull([CMB_種別]) Then [TXT_種別名] = [CMB_種別].Column(1) Else [TXT_種別名] = Null End If End Sub |
|
| データシート形式のフォームで、↑キー・↓キーによるレコード移動 |
|
| "txtData1"テキストボックスでキーボードが操作されたとき Private Sub txtData1_KeyDown(KeyCode As Integer, Shift As Integer) CurslUpDown KeyCode End Sub 複数のフォームでこの方法を使う場合には次のプロシージャは"標準モジュール"に作成。 Sub CurslUpDown(KeyCode As Integer) On Error Resume Next If KeyCode = vbKeyUp Then DoCmd.GoToRecord , , acPrevious ElseIf KeyCode = vbKeyDown Then DoCmd.GoToRecord , , acNext End If End Sub |
|
| フォーム内コントロール、チェック（編集ロック） |
|
| Dim FRM As Form Dim CTL As Control Set FRM = Forms("F伝票") For Each CTL In FRM.Controls ' フォーム内のコントロールをチェック If CTL.Section = acDetail Then ' フォームの詳細セクション If CTL.ControlType = acTextBox Or CTL.ControlType = acComboBox Or CTL.ControlType = acSubform Then With CTL .Locked = chk_編集ロック End With End If End If Next CTL |
|
| IMEをOFFにする |
|
|
'ＩＭＥ(ＦＥＰ：フロントエンドプロセッサー)の現在の状態を取得し、ＩＭＥがＯＦＦ又は使用不可のどちらかの状態以外の時、ＩＭＥをＯＦＦにする。 '引数 ： なし'戻り値 ： なし 'システム定数 ： vbIMEOff IME はオフの状態です。 ' ： vbIMEDiusable IME は利用禁止状態です。 Public Function IMEOFF() As Variant If (IMEStatus = vbIMEOff) Or (IMEStatus = vbIMEDisable) Then Else SendKeys "^25", True DoEvents End If End Function |
|
| Escapeキーのコントロール |
|
| ※フォームの[キーボードイベント取得]プロパティを"はい"に設定 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case vbKeyEscape If Screen.ActiveControl.SECTION = acHeader Then Call CMD_終了_Click ' メインフォーム=アプリケーション終了 ElseIf Screen.ActiveControl.SECTION = acDetail Then Call CMD_中止_Click ' 詳細セクションからメインメニューへ End If End Select End Sub ------------------ If Screen.ActiveControl.Name = "CMD_終了" Then Call CMD_終了_Click Else Call CMD_中止_Click End If |
|
| 文字列が半角、全角、混在かを判断する |
|
| Sub Sample() Dim strANSI As String Dim myLen As Integer Dim myLenB As Integer Dim strUnicode As String strUnicode = InputBox(Prompt:="判断する文字列を入力してください", Title:="文字列の種類判断") If strUnicode = "" Then Exit Sub strANSI = StrConv(strUnicode, vbFromUnicode) myLen = Len(strUnicode) myLenB = LenB(strANSI) If myLen * 2 = myLenB Then MsgBox "全角文字だけです" ElseIf myLen = myLenB Then MsgBox "半角文字だけです" Else MsgBox "全角と半角が混じっています" End If End Sub Access95以降、AccessはUnicode対応のアプリケーションとなりましたので、Len関数/LenB関数のみで文字列が半角、全角、混在かを判断することは不可能です。そこで、ある文字列がすべて半角か、すべて全角か、あるいは混在かを判断するのにStrConv関数とLen関数/LenB関数を使った方法をご紹介します。まず、インプットボックスを表示して、判断する文字列を入力します。入力された文字列は、StrConv関数でANSI文字列に変換してから文字数とバイト数を求めて判断します。 半角４２文字以上の場合、強制的に４２文字に修正。 Private Sub TXT_摘要名_AfterUpdate() If Not IsNull([TXT_摘要名]) Then If LenB(StrConv([TXT_摘要名], vbFromUnicode)) > 42 Then [TXT_摘要名] = StrConv([TXT_摘要名], vbFromUnicode) [TXT_摘要名] = LeftB([TXT_摘要名], 42) [TXT_摘要名] = StrConv([TXT_摘要名], vbUnicode) End If End If End Sub |
|
| 文字列バイト長・文字数 |
|
| バイト数チェックによる、バイト長による制限などにも使用できます。 (バイトチェック、byte 数チェック、byte チェック、バイト数制限) (バイト制限、byte 数制限、byte 制限、文字数チェック、文字チェック) (文字数制限、文字制限、文字列チェック、文字列制限、バイト計算) (byte 計算、文字数計算) 【引数】 s = 文字列 【戻り値】 integer = バイト長 ・文字列バイト長を VB 2.0 互換の半角を 1 バイト、全角を 2 バイトとして計算して返します。 Public Function LenByte(s As Variant) As Integer Dim i As Integer Dim cd As Integer Dim ct As Integer '** バイト数計算 For i = 1 To Len(s) cd = Asc(Mid(s, i, 1)) If cd < 0 Or cd > 255 Then ct = ct + 2 Else ct = ct + 1 End If Next '** バイト数セット LenByte = ct End Function |
|
| データのバックアップ（ファイルコピー） |
|
| Private Sub CMD_バックアップ_Click() Set RS = CurrentDb.OpenRecordset("T_SYSTEM", dbOpenDynaset) If RS.EOF = True Then Beep Call MSGBOX2("システム設定をして下さい", vbOKOnly, "確認") GoTo BAK_END End If Beep If MSGBOX2(RS!Backup_From & "A" & RS!Backup_To & "B", vbOKCancel, "確認") = vbCancel Then GoTo BAK_END If Dir(RS!Backup_From, vbNormal) = "" Then Beep Call MSGBOX2("バックアップ元を確認して下さい", vbOKOnly, "確認") GoTo BAK_END End If If Dir(Left(RS!Backup_To, Len(RS!Backup_To) - 10)) = "" Then ' MkDir (Left(RS!Backup_To, Len(RS!Backup_To) - 10)) End If FileCopy RS!Backup_From, RS!Backup_To Call MSGBOX2("終了しました。", vbOKOnly, "確認") BAK_END: RS.Close End Sub Dir=指定したパターンやファイル属性と一致するファイルまたはフォルダの名前を表す文字列型 (String) の値を返す。 MkDir=新しいフォルダを作成 LEN=指定した文字列の文字数または指定した変数に必要なバイト数を表す長整数型 (Long) の値を返す。 |
|
| レポート | |||
 レコードがない場合も用紙の最後まで罫線を出力する方法 |
|||
| Private Sub ページヘッダーセクション_Format(Cancel As Integer, FormatCount As Integer) j = DCount("*", "T_WRK請求明細") End Sub Private Sub レポートヘッダー_Format(Cancel As Integer, FormatCount As Integer) i = 0 End Sub Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
Private Function CTL_可視(VIS As Boolean) [TXT_入力区分].Visible = VIS [TXT_伝票番号].Visible = VIS …… End Function グループ化をしているレポートで 指定したレコード件数ごとに改ページをし、かつ、同グループのレコード件数が指定したレコード件数に満たない場合にも、罫線だけは印字するレポートを作成する方法。 ・グループ化するフィールドを設定 ・改ページ コントロールを詳細セクションに配置。 （線も）改ページコントロールとフッターセクションの間にスペースが入らないように。 ・グループヘッダーの 改ページ/プロパティ＝[カレントセクションの前] ・グループヘッダーの "OnFormat/フォーマット時"イベントプロシージャを設定。 Dim i , j （モジュール単位で宣言） Private Sub グループヘッダー 0_Format(Cancel As Integer, FormatCount As Integer) i = 0 j = DCount("*", "商品", "[区分コード]= reports![商品]![区分コード]") End Sub "詳細" セクションの "OnFormat/ フォーマット時"イベントプロシージャを設定。 Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer) i = i + 1 If i Mod 10 = 0 Then '10行ごとに改ページ If i <= j Then Me![bpage].Visible = True Else Me![商品コード].Visible = False End If Else Me![bpage].Visible = False If i < j Then Me.NextRecord = True Me![商品コード].Visible = True ElseIf i = j Then Me.NextRecord = False '現在のレコード位置を次へ進めない Me![商品コード].Visible = True Else Me.NextRecord = False Me![商品コード].Visible = False End If End If End Sub |
|||
| レポートの改ページ |
|||
| [詳細]セクションの下の方に改ページコントロールを挿入。（コントロール名＝改ページ１） [詳細]セクションの[フォーマット時]イベント テキストボックス・数量が300を超える場合、改ページ。 Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer) If Me!数量 > 300 Then Me!改ページ1.Visible = True Else Me!改ページ1.Visible = False End If End Sub Private Sub ページヘッダー_Format(Cancel As Integer, FormatCount As Integer) Me![改ページ].Visible = False End SubPrivate Sub 詳細_Format(Cancel As Integer, FormatCount As Integer) If [TXT_ID] = 24 Then Me![改ページ].Visible = True End If End Sub |
|||
| 日付・時間計算 | |
 末日の関数 |
|
| 翌月の1日の年月日を取得しておいて、DateAdd関数を。 DateAdd関数は、指定された時間間隔を加算した日付を返す。 DateSerial関数で現在の日付から翌月の1日の年月日を取得して、その日付から-1日した日付を取得。 Sub Sample() Dim myDate As Date myDate = DateSerial(Year(Date), Month(Date) + 1, 1) MsgBox DateAdd("d", -1, myDate) End Sub Sub Sample() '今月の月末日 MsgBox DateSerial(Year(Date), Month(Date) + 1, 0) '前月の月末日 MsgBox DateSerial(Year(Date), Month(Date), 0) '翌月の月末日 MsgBox DateSerial(Year(Date), Month(Date) + 2, 0) End Sub 当月末日付を取得 [TXT_日付2] = DateAdd("D", -1, DateSerial(Year([TXT_処理日付1]), Month([TXT_処理日付1]) + 1, 1)) [TXT_日付2] = DateSerial(Year([TXT_処理日付2]), Month([TXT_処理日付2]) + 1, 0) [TXT_日付2] = Format([TXT_処理日付2], "GGGEE\年MM\月DD\日") 一年後日付を取得 [TXT_終了期間] = DateAdd("YYYY", 1, [TXT_開始期間]) [TXT_終了期間] = DateAdd("D", -1, [TXT_終了期間]) [TXT_終了期間] = Format([TXT_終了期間], "YY\年MM\月DD\日") |
|
| 生年月日から、年齢を取得 |
|
| 翌月の1日の年月日を取得しておいて、DateAdd関数を。 Private Sub TXT_生年月日_AfterUpdate() If IsDate([TXT_生年月日]) = True Then [TXT_年齢] = DateDiff("yyyy", [TXT_生年月日], Date) If Format([TXT_生年月日], "MM/DD") > Format(Date, "MM/DD") Then [TXT_年齢] = (Val([TXT_年齢]) - 1) & "歳" End If Else [TXT_年齢] = Null End If End Sub |
|
| 時間の集計 |
|
| 例：合計時間としての「1234分」を「Y時間X分」に変換する ○時間...［時間(分)］を60で割り、小数点以下をInt関数で切り捨てる。 例） Int([時間]/60) ○分.....［時間(分)］を60で割ったときのあまりを、Mod演算子で出す。 例） [時間] Mod 60 |
|