備忘録：Access ・フォームのエラー処理を一か所で行う

Accessでフォームを多数使用する場合、各フォームにエラー処理を埋め込むのは効率が悪い。
各フォームのエラー発生時のイベントにcall文を一行記載して、実際の処理は標準モジュールで行うようにすれば、エラー処理を一か所で行えるし、後々の更新も楽。

フォーム側の「エラー時」イベント

Private Sub Form_Error(DataErr As Integer, Response As Integer)
'エラー時（各フォーム）
    Call ErrorModule(DataErr, Response)    
End Sub

標準モジュール側

Public Sub ErrorModule(DataErr As Integer, Response As Integer)
'Formエラー処理（標準モジュール）
    Select Case DataErr
        Case 7787              'データ競合
            Response = acDataErrContinue
            MsgBox "他のメンバーが先にレコードを更新している為、入力を中止します。" & vbCrLf & _
                "再度入力してください。", vbInformation + vbOKOnly, "データ競合エラー"
        Case 3022              'データ重複
            Response = acDataErrContinue
            MsgBox "顧客コード もしくは 履歴コードに重複が存在するため、処理を中断します。" & vbCrLf & _
                   "Escキーで離脱できます。", , "重複エラー"
        Case 3316               '電話番号等の入力規則違反
            Response = acDataErrDisplay
        Case 3314               '必須入力欄が空
            Response = acDataErrDisplay
        Case 2113               '入力規則違反
            Response = acDataErrDisplay
        Case 2237               'ドロップダウン項目以外を入力
            Response = acDataErrDisplay
        Case 3163               '入力文字数オーバー
            Response = acDataErrDisplay
        Case Else
            MsgBox "エラー番号：" & DataErr & "が、フォーム上で発生しました。"
            Response = acDataErrDisplay     'Access標準エラーメッセージを有効
    End Select
End Sub

備忘録：Access ・サブフォーム等のオブジェクトをウインドウサイズに合わせ自動調整

フォームの中にタブコントロールを配置して、帳票リストなどを切り替えて表示したい時、「親シート」の中に「タブコントロール」を作成して「タブコントロール」の中に「帳票フォーム（サブフォーム）」を埋め込む事になりますが、この場合サブフォームのサイズの上限が、タブコントロールや親フォームのサイズに制約されてしまいます。
かと言って最初から大きく作ると、Accessのウインドウサイズを小さく開いた場合、親フォームとサブフォームのスクロールバーに右往左往する事態になったり、毎度スクロールしないとタブが隠れてしまったりと大変です。

このような場合、ウインドウサイズに合わせて配下のコントロールのサイズを都度変更するようなVBAを書くことで改善できます。

親フォームの「サイズ変更時」のイベントに以下のソースを貼り付けます。
Me.InsideHeightは、ヘッダーやフッターのサイズも合計した高さを取得する為、ヘッダーとフッターの高さを差し引く事で、詳細部分の高さを算出し、その数字を埋め込みオブジェクトの高さに指定します。
「-450」はタブの厚み分の数字なので、タブオブジェクトを使用しない場合は不要です。

    'サブシートサイズ調整
    Me!サブシート名.Height = (Me.InsideHeight) - (Me.フォームヘッダー.Height) - (Me.フォームフッター.Height) - 450
    Me!サブシート名.Width = Me.InsideWidth
    'タブコントロールサイズ調整
    Me!タブコントロール名.Height = (Me.InsideHeight) - (Me.フォームヘッダー.Height) - (Me.フォームフッター.Height) - 450
    Me!タブコントロール名.Width = Me.InsideWidth

備忘録：エクセル ・重複を自動で除外するドロップダウンリストの作り方

例えばこのようなリストがあって、

A列の情報をドロップダウンリストで、
このように重複を除外して表示したい時、

計算用にC列D列を用意して、

各セルの関数は、以下の通にすればＯＫ。
C2セル

=IF(COUNTIF($A$2:$A2,A2)=1,ROW()-0,"")

D2セル

=INDIRECT(ADDRESS(SMALL($C$2:$C$12,ROW()-1),1))

リストの開始行と列に合わせて赤の数字と緑の数字を変更し、最下段まで式を引っ張ると良い。

重複を除外したい元のリストの開始行が、
　2行目からだと、-0と-1
　3行目からだと、-1と-2
　4行目からだと、-2と-3
そんな感じ。

重複を除外したい元のリスト列が
　A列だと、1
　B列だと、2
　C列だと、3

コンボボックス側は、
データの入力規則＞リスト＞元の値
の式をこうする。

=OFFSET($D$2,0,0,COUNTIF($D$2:$D$12,"<>#NUM!"),1)

赤字の開始位置と範囲の指定は、D列の青く囲んでいる範囲を指定する。

備忘録：エクセルVBA ・指定したシートをCSVファイルに出力する

ソースを丸ごと張り付けるだけ。VBAを実行すると、全てのシート名が入力された状態でInputBoxが表示されるので、出力したいシート名だけをInputBoxに残し、その後ファイルの保存先を選択すれば、CSVファイルが作成される。

同名のファイルがある場合は上書保存され、同名のファイルが開かれている場合は、エラーとなり処理が終了されます。

Sub csv_output()
    '指定したシートをCSVファイルに出力する

    Dim CsvName As Variant      '出力ファイルのフルパス
    Dim OutSeet As Worksheet    '出力対象のシート
    Dim i As Integer
    Dim mySheetCnt As Long      '既存シート数
    Dim mySheetName As String   'シート名一覧
    Dim TgtSeetName As String   'InputBoxの戻り値
    
'出力するシート名の選択
    mySheetCnt = ThisWorkbook.Sheets.Count
    For i = 1 To mySheetCnt
        mySheetName = mySheetName & Sheets(i).Name & "，"
    Next i
    TgtSeetName = Application.InputBox(Prompt:="出力を行うシート名を正確に入力してください。" _
    & vbLf & "（表示されている中から、不要なシート名や「, 」を削除してください）", _
    Title:="どのシートをエクスポートしますか？", Default:=mySheetName)
    If TgtSeetName = "False" Then
        Exit Sub
    Else
        On Error GoTo SEET_NAME_ERROR
        Set OutSeet = Worksheets(TgtSeetName)   'シート名セット
        On Error GoTo 0
    End If

'ファイル保存先の取得
    CsvName = Application.GetSaveAsFilename(FileFilter:="CSVファイル,*.csv")
    If CsvName = False Then
        Exit Sub
    End If
    
'同名のファイルが開かれていないか確認
    On Error Resume Next
    Open CsvName For Output As #1
    Close #1

    If Err.Number > 0 Then
        MsgBox "同名のファイルがすでに開かれています。" & vbCrLf & CsvName & _
        "を閉じてやり直してください。"
        Workbooks(CsvName).Activate
    Else
'対象シートをコピーしてCSVファイル保存
        Application.DisplayAlerts = False
        OutSeet.Copy
        ActiveWorkbook.SaveAs FileName:=CsvName, FileFormat:=xlCSV
        ActiveWindow.Close
        Application.DisplayAlerts = True
        MsgBox CsvName & "を出力しました。", , "ファイル作成完了"
    End If
    
SEET_NAME_ERROR:
    If Err.Number = 9 Then
        MsgBox "CSVを出力したいシート名を、正しく指定してください。", , _
        "シート名が存在しません"
    End If
    Exit Sub
End Sub

リスト作成作業

ある案件にて、既存DB→新規DBへのデータの引越し作業をしています。

新規DBにデータを取り込むのは一瞬ですが、その前段階として、取り込むデータを手直しするのが大変です。

もう何度も経験していますが個人情報のメンテナンスは、精神的にも重圧を感じます。

既存DBから顧客リストをエクセルに吐きだし、そこからひたすらエクセル上での作業ですが、段ズレなどが発生しないように、自分なりにルールを決めて作業を進めています。

この辺、同じような経験がある方はお分かり頂けるかと思います。

仕事は失敗を繰り返して覚えるものですが、こればかりはそうも言えません・・・

普段からもう少しきれいにデータベース入力をして頂ければ、この手の作業が楽になるんですけどね。

いやそもそも、データベースの入力ルール定義が甘いのが根本的原因ですね。

可用性と完全性のいいところを取るのは難しいです。