精品人妻中文无码av在线,亚洲久本草在线中文字幕,精品特级一级毛片免费观看

當(dāng)前位置：主頁(yè) > 技巧 > Access技巧 > 數(shù)據(jù)表 > 正文

如何設(shè)置表的Caption和Description屬性，即“標(biāo)題”和“說(shuō)明”屬

時(shí)間：2014-11-17 12:58 來(lái)源：access911.net 作者：cg1翻譯閱讀：次

問(wèn)題：

如何設(shè)置表的Caption和Description屬性，即“標(biāo)題”和“說(shuō)明”屬性

回答：

注意！無(wú)法通過(guò) JET SQL 來(lái)設(shè)置或者修改上述屬性，JET SQL 不支持此功能，你可以聯(lián)系微軟開(kāi)發(fā)小組要他們?cè)谙乱粋€(gè)版本中增加此功能。

Function AppendCaption()
    '引用DAO

    Dim Tbf As DAO.TableDef
    Dim fld As DAO.Field
    Dim p As DAO.Property
    Dim cp As DAO.Property
    On Error Resume Next
    Dim i As Integer

    Dim TableName As String
    Dim FieldName As String
    FieldName = "First_name"
    TableName = "test"

    For Each Tbf In CurrentDb.TableDefs
        'Debug.Print Tbf.Name
        For Each fld In Tbf.Fields
            'Debug.Print Fld.Name
            If fld.Name = FieldName And Tbf.Name = TableName Then
                Set cp = fld.CreateProperty("Caption", 12, "aa")
                fld.Properties.Append cp
                Set cp = fld.CreateProperty("Description", 10, "aa")
                fld.Properties.Append cp

            End If
            For Each p In fld.Properties
                If p.Name = "caption" Then
                    Debug.Print Tbf.Name & ":" & fld.Name & ":" & "pro:"; p.Name & "--" & p.Value
                    'Fld.Properties.Delete "Caption"        '刪除屬性
                End If
            Next
        Next
    Next

End Function

下面再給一段函數(shù)

Function GetFieldProperty(F As Field, _
                             ByVal PropName As String) As Variant
   '
   ' Returns NULL if the property doesn't exist
   '
     On Error Resume Next
     GetFieldProperty = F.Properties(PropName)
End Function

Sub ModifyFieldProperty(F As Field, ByVal PropName As String, _
                           ByVal PropType As Long, _
                           ByVal NewVal As Variant)
   Dim P As Property
     On Error Resume Next
     Set P = F.Properties(PropName)
     If Err Then
       '
       ' Add property (as long as NewVal isn't Null)
       '
       If Not IsNull(NewVal) Then
         On Error Goto 0      ' fail if can't add
         Set P = F.CreateProperty(PropName, PropType, NewDesc)
         F.Properties.Append P
       End If
     ElseIf IsNull(NewVal) Then
       '
       ' Delete property
       '
       On Error Goto 0      ' fail if can't delete
       F.Properties.Delete PropName
     Else
       '
       ' Modify property
       '
       On Error Goto 0      ' fail if can't alter
       P.Value = NewDesc
     End If
     Set P = Nothing
End Sub

調(diào)用函數(shù)如下：

    Sub Test()
      Dim db As Database, F As Field
      Dim v As Variant
      v = "This is a description"
      Set db = DBEngine(0).OpenDatabase("NWIND.MDB") ' change name/path
      Set F = db!Employees!Title
      ' Get existing description
      Debug.Print "Existing Title Description is: ";
      Debug.Print GetFieldProperty(F, "Description")
      ' Delete description
      ModifyFieldProperty F, "Description", dbText, v
      Debug.Print "After deleting Description: ";
      Debug.Print GetFieldProperty(F, "Description")
      ' Add description
      ModifyFieldProperty F, "Description", dbText, "Employee's Title"
      Debug.Print "After adding new Description: ";
      Debug.Print GetFieldProperty(F, "Description")
      ' Modify existing title
      ModifyFieldProperty F, "Description", dbText, "Emp Title"
      Debug.Print "After modifying Description: ";
      Debug.Print GetFieldProperty(F, "Description")
      ' Clean-up
      Set F = Nothing
      db.Close
   End Sub

再提供一個(gè)別人發(fā)表的代碼（未測(cè)試）

'*******************************************************************************
'Function:       TableDefExist(strTableDef)
'Description:    Returns a Boolean value that indicates whether an table define
'                in currently database.
'Example:        TableDefExist("TEXT")=True
'*******************************************************************************
Function TableDefExist(ByVal strTableDef As String) As Boolean
On Error GoTo TableDefExist_Err
    If CurrentDb.TableDefs(strTableDef).Name = strTableDef Then
        TableDefExist = True
    End If
    TableDefExist = True
    Exit Function
TableDefExist_Err:
    TableDefExist = False
    Exit Function
End Function

Private Sub CreateTRDTableDef()

On Error GoTo Err_CreateTRDTableDef

Dim rstTRDTableSource As DAO.Recordset
Dim rstTableDefine As DAO.Recordset
Dim tdfTable As DAO.TableDef
Dim dbCurrentDatabase As DAO.Database
Dim fldField As Field
Dim intCount As Integer
Dim strTableName As String

    DoCmd.Echo True, "Creating table definition......"
    Set dbCurrentDatabase = CurrentDb
    Set rstTRDTableSource = dbCurrentDatabase.OpenRecordset("SELECT DISTINCT TRD_NAME,TABLE_NAME FROM TBL_TABLE_SOURCE", dbOpenDynaset)

    Do While Not rstTRDTableSource.EOF

        strTableName = rstTRDTableSource("TRD_NAME") & " - " & rstTRDTableSource("TABLE_NAME")
        DoCmd.Echo True, "Creating " & strTableName & " table definition....."
        If TableDefExist(strTableName) Then
            dbCurrentDatabase.TableDefs.Delete strTableName
        End If

        Set rstTableDefine = CurrentDb.OpenRecordset("SELECT * FROM TBL_TABLE_SOURCE WHERE TRD_NAME=" & "'" & _
            rstTRDTableSource("TRD_NAME") & "' AND TABLE_NAME='" & rstTRDTableSource("TABLE_NAME") & "' ORDER BY SEQUENCE", dbOpenDynaset)
        Set tdfTable = dbCurrentDatabase.CreateTableDef(strTableName)
        Set fldField = tdfTable.CreateField(rstTableDefine.Fields("FIELD_NAME"), GedFieldType(rstTableDefine.Fields("DATA_TYPE")), rstTableDefine.Fields("FIELD_SIZE"))

        tdfTable.Fields.Append fldField
        dbCurrentDatabase.TableDefs.Append tdfTable

        SetMyProperty fldField, "Caption", dbText, rstTableDefine.Fields("Caption")
        SetMyProperty fldField, "Description", dbText, rstTableDefine.Fields("DESCRIPTION")
        rstTableDefine.MoveNext

        With rstTableDefine
            Do While Not .EOF
                Set fldField = tdfTable.CreateField(.Fields("FIELD_NAME"), GedFieldType(.Fields("DATA_TYPE")), .Fields("FIELD_SIZE"))

                tdfTable.Fields.Append fldField
                SetMyProperty fldField, "Caption", dbText, rstTableDefine.Fields("Caption")
                SetMyProperty fldField, "Description", dbText, rstTableDefine.Fields("DESCRIPTION")

                .MoveNext
            Loop
        End With

        Set tdfTable = Nothing
        rstTableDefine.Close
        Set rstTableDefine = Nothing
        rstTRDTableSource.MoveNext
    Loop

    rstTRDTableSource.Close
    Set rstTRDTableSource = Nothing

    DoCmd.Echo True, "Ready"


Exit_CreateTRDTableDef:
    Exit Sub

Err_CreateTRDTableDef:
    MsgBox "Error: " & Err & vbCrLf & Err.Description
    Resume Exit_CreateTRDTableDef

End Sub

'*******************************************************************************
'Function:       GedFieldType(strDataType)
'Description:    Returns a integer value that indicates data types
'Example:        GedFieldType("dbText")=10
'*******************************************************************************

Function GedFieldType(strDataType As String) As Integer
Select Case strDataType
    Case "dbText"
        GedFieldType = 10
    Case "dbDate"
        GedFieldType = 8
    Case "dbDouble"
        GedFieldType = 7
    Case "dbFloat"
        GedFieldType = 21
    Case "dbInteger"
        GedFieldType = 3
    Case "dbLong"
        GedFieldType = 4
    Case "dbMemo"
        GedFieldType = 12
    Case "dbNumeric"
        GedFieldType = 6   'old is 19
    Case "dbSingle"
        GedFieldType = 6
    Case "dbTime"
        GedFieldType = 22
    Case "dbChar"
        GedFieldType = 18
    Case "dbCurrency"
        GedFieldType = 5
    Case Else
        GedFieldType = 0
End Select

End Function

'*******************************************************************************
'Sub:            SetMyProperty(Obj,Name,Type,Setting)
'Description:    Custom a user property
'Example:        SetMyProperty fldField, "Caption", dbText, "Test Information"
'*******************************************************************************

Sub SetMyProperty(Obj As Object, strName As String, intType As Integer, strSetting As String)
    Dim Prp As Property
    Const PrpFail As Integer = 3270
    On Error GoTo Err_SetMyProperty

    Obj.Properties(strName) = strSetting
    Obj.Properties.Refresh

Exit_SetMyProperty:
Exit Sub

Err_SetMyProperty:

    If Err = PrpFail Then
      Set Prp = Obj.CreateProperty(strName, intType, strSetting)
      Obj.Properties.Append Prp
      Obj.Properties.Refresh
    Else
      MsgBox "Error: " & Err & vbCrLf & Err.Description
    End If

    Resume Exit_SetMyProperty

End Sub

(責(zé)任編輯：admin)

頂一下

(0)

踩一下

(0)

上一篇：刷新聯(lián)接表的函數(shù)
下一篇：表中字段名命令的注意事項(xiàng)

相關(guān)內(nèi)容