从 AUTO 更改 VBA 中的 DecimalPlaces 属性

Question

我有一个复杂的报告模块，可以动态创建报告，这就是我以编程方式添加表格的原因，这是一种允许添加和编辑报告而无需重新设计应用程序的方法。 一切都是动态的，有一组表存储配置参数，添加或更改报告只需要更改这些配置表中的一些数据。

所以，需要更改DecimalPlaces属性，它默认设置为Auto，我想将其更改为0或2（取决于设置）。 代码没有给出任何错误，但属性没有改变，DecimalPlaces 仍然显示全部为 AUTO。我单步执行了代码，它执行了这些行，表中没有任何变化。

Sub test()
    fnReports 4
End Sub

Function fnReports(vrReportNo As Long)

    Dim db As DAO.database
    Dim rs As DAO.Recordset
    Dim rsS As DAO.Recordset
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim vrSQL As String
    Dim i As Integer
    Dim vrTableName As String
    
    'create report table
     
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
 
    Set db = CurrentDb
    
    vrTableName = "mtMDAR" & vrReportNo
    
    vrSQL = "SELECT MDARReportFields.SortNoField, MDARReportFields.FieldName, MDARReportFields.FieldSize, FieldFormats.FieldFormat " & _
            ", MDARReportFields.FieldDecimalNo, FieldDataTypes.FieldDataTypeNo, FieldDataTypes.FieldDataType, FieldDataTypes.FieldDataTypeVBA " & _
            "FROM FieldFormats RIGHT JOIN (FieldDataTypes RIGHT JOIN MDARReportFields ON FieldDataTypes.FieldDataTypeID = MDARReportFields.FieldDataTypeID) " & _
            "ON FieldFormats.FieldFormatID = MDARReportFields.FieldFormatID WHERE MDARReportFields.ReportNo=" & vrReportNo & "  ORDER BY MDARReportFields.SortNoField"
    
    fnDeleteObjectIfExists "table", vrTableName
    Set tdf = db.CreateTableDef(vrTableName)
    
    Dim vrSortNoField As Long
    Dim vrFieldName As String
    Dim vrFieldSize As Long
    Dim vrFieldFormat As String
    Dim vrFieldDecimalNo As Long
    Dim vrFieldDataTypeNo As Long
    Dim vrFieldDataType As String
    Dim vrFieldDataTypeVBA As String
    Dim prp As DAO.Property
 
    Set db = CurrentDb
    Set rsS = db.OpenRecordset(vrSQL, dbOpenSnapshot)
   

    Do Until rsS.EOF
     
        vrFieldName = rsS!FieldName
        vrFieldDataTypeNo = rsS!FieldDataTypeNo
        If vrFieldDataTypeNo = 10 Then
            vrFieldSize = rsS!FieldSize
        End If

        With tdf
            If vrFieldDataTypeNo = 10 Then
                Set fld = .CreateField(vrFieldName, vrFieldDataTypeNo, vrFieldSize)
            Else
                Set fld = .CreateField(vrFieldName, vrFieldDataTypeNo)
            End If
            .Fields.Append fld
        End With

        rsS.MoveNext
    Loop
 
    db.TableDefs.Append tdf
    
    
    Set rsS = db.OpenRecordset(vrSQL, dbOpenSnapshot)
    Do Until rsS.EOF
    
        'vrSortNoField = rsS!SortNoField
        vrFieldName = rsS!FieldName
        vrFieldDataTypeVBA = rsS!FieldDataTypeVBA
        vrFieldDataTypeNo = rsS!FieldDataTypeNo
        vrFieldDataType = rsS!FieldDataType
        If vrFieldDataTypeNo <> 5 And vrFieldDataTypeNo <> 10 Then
            vrFieldFormat = rsS!FieldFormat
            vrFieldDecimalNo = rsS!FieldDecimalNo
        End If
    

        With tdf
            Set fld = .Fields(vrFieldName)
         
            If vrFieldDataTypeNo <> 5 And vrFieldDataTypeNo <> 10 Then
    
                Set prp = fld.CreateProperty("DecimalPlaces", vrFieldDataTypeNo, vrFieldDecimalNo)
                fld.Properties.Append prp
                 
         
                Set prp = fld.CreateProperty("Format", dbText, vrFieldFormat)
                fld.Properties.Append prp
            
            End If
  
        End With

        rsS.MoveNext
    Loop
 

    Set tdf = Nothing
    rsS.close
    Set rsS = Nothing
 
    Set db = Nothing
    
     
End Function

Answer 1

解决了 原来 DecimalPlaces 的数据类型是 dbByte，而不是字段的属性

所以，这个

prp = fld.CreateProperty("DecimalPlaces", vrFieldDataTypeNo, vrFieldDecimalNo)

一定是这个

prp = fld.CreateProperty("DecimalPlaces", dbByte, vrFieldDecimalNo)