Accessvbaでのsqlを使用したsingle,doubleを対象とした四捨五入処理(chatgpt産)

' ※ このコードを標準モジュールに貼り付けます
' 参照設定：Microsoft ActiveX Data Objects Library と Microsoft DAO 3.6 (またはそれ以降) が必要

Public Sub RoundDecimalFields(ByRef adoConn As ADODB.Connection)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim sql As String
Dim tblName As String
Dim fldName As String

' 現在のデータベースを取得
Set db = CurrentDb

' DAO.TableDefs をループしてシステムテーブル以外（＝ローカル／リンクテーブル）を対象にする
For Each tdf In db.TableDefs
    ' ※ システムテーブルは属性で除外
    If (tdf.Attributes And dbSystemObject) = 0 Then
        tblName = tdf.Name
        ' 各テーブルのフィールドをループ
        For Each fld In tdf.Fields
            ' ※ フィールドの型が Single 型または Double 型の場合
            If fld.Type = dbSingle Or fld.Type = dbDouble Then
                fldName = fld.Name
                ' UPDATE クエリ作成（NULL は対象外）
                sql = "UPDATE [" & tblName & "] " & _
                      "SET [" & fldName & "] = Round([" & fldName & "], 4) " & _
                      "WHERE [" & fldName & "] IS NOT NULL;"
                
                ' エラー発生時はメッセージ出力して次のフィールドへ
                On Error Resume Next
                adoConn.Execute sql
                If Err.Number <> 0 Then
                    Debug.Print "更新エラー (テーブル：" & tblName & " フィールド：" & fldName & "): " & Err.Description
                    Err.Clear
                End If
                On Error GoTo 0
            End If
        Next fld
    End If
Next tdf

' オブジェクトの解放
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing

MsgBox "四捨五入処理が完了しました。", vbInformation

End Sub