从组合框中复制文本,而不是复制我的Access审核跟踪中的主键

问题描述 投票:1回答:1

我已经进行了一个星期的工作,但仍未找到解决方法...在我的访问文件中,我有以下代码创建对表单所做的更改的审核跟踪,您能为我提供帮助吗?修改下面的代码,以便从组合框或选项组进行更改时,审核记录显示组合框/选项组内的文本值,而不是与该文本值关联的主键?

非常感谢。

K

Option Compare Database

Const cDQ As String = """"
Sub AuditTrail(frm As Form, recordid As Control)
  'Track changes to data.
  'recordid identifies the pk field's corresponding
  'control in frm, in order to id record.
  Dim ctl As Control
  Dim varBefore As Variant
  Dim varAfter As Variant
  Dim strControlName As String
  Dim strSQL As String
  On Error GoTo ErrHandler
  'Get changed values.
  For Each ctl In frm.Controls
    With ctl
    'Avoid labels and other controls with Value property.
    Select Case ctl.ControlType
    Case acTextBox, acComboBox, acListBox, acOptionGroup

      If IsNull(.Value) And Not IsNull(.OldValue) Then
        varBefore = .OldValue
        varAfter = .Value
        strControlName = .Name
        'Build INSERT INTO statement.
        strSQL = "INSERT INTO " _
           & "Audit (EditDate, User, RecordID, SourceTable, " _
           & " SourceField, BeforeValue, AfterValue) " _
           & "VALUES (Now()," _
           & cDQ & Environ("username") & cDQ & ", " _
           & cDQ & recordid.Value & cDQ & ", " _
           & cDQ & frm.RecordSource & cDQ & ", " _
           & cDQ & .Name & cDQ & ", " _
           & cDQ & varBefore & cDQ & ", " _
           & cDQ & varAfter & cDQ & ")"
        'View evaluated statement in Immediate window.
        Debug.Print strSQL
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSQL
        DoCmd.SetWarnings True

      ElseIf IsNull(.OldValue) And Not IsNull(.Value) Then
        varBefore = .OldValue
        varAfter = .Value
        strControlName = .Name
        'Build INSERT INTO statement.
        strSQL = "INSERT INTO " _
           & "Audit (EditDate, User, RecordID, SourceTable, " _
           & " SourceField, BeforeValue, AfterValue) " _
           & "VALUES (Now()," _
           & cDQ & Environ("username") & cDQ & ", " _
           & cDQ & recordid.Value & cDQ & ", " _
           & cDQ & frm.RecordSource & cDQ & ", " _
           & cDQ & .Name & cDQ & ", " _
           & cDQ & varBefore & cDQ & ", " _
           & cDQ & varAfter & cDQ & ")"
        'View evaluated statement in Immediate window.
        Debug.Print strSQL
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSQL
        DoCmd.SetWarnings True

      ElseIf .Value <> .OldValue Then
        varBefore = .OldValue
        varAfter = .Value
        strControlName = .Name
        'Build INSERT INTO statement.
        strSQL = "INSERT INTO " _
           & "Audit (EditDate, User, RecordID, SourceTable, " _
           & " SourceField, BeforeValue, AfterValue) " _
           & "VALUES (Now()," _
           & cDQ & Environ("username") & cDQ & ", " _
           & cDQ & recordid.Value & cDQ & ", " _
           & cDQ & frm.RecordSource & cDQ & ", " _
           & cDQ & .Name & cDQ & ", " _
           & cDQ & varBefore & cDQ & ", " _
           & cDQ & varAfter & cDQ & ")"
        'View evaluated statement in Immediate window.
        Debug.Print strSQL
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSQL
        DoCmd.SetWarnings True

      End If
    End Select
    End With
  Next
  Set ctl = Nothing
  Exit Sub

ErrHandler:
  MsgBox Err.Description & vbNewLine _
   & Err.Number, vbOKOnly, "Error"
End Sub

vba ms-access access-vba ms-access-2010 ms-access-2016
1个回答
0
投票

对于组合框,包括文本字段作为组合框的列,并通过其索引引用该列。组合框行来源,例如SELECT ID, fieldname FROM table;。设置ColumnCount:2; ColumnWidths:0“; 2”(0将隐藏列)。索引以0开头,因此如果文本字段是第二列,则其索引为1。Me.combobox.Column(1)

假定选项组使用单选按钮,每个单选按钮都有一个数字OptionValue。选项组框架采用选定的单选按钮OptionValue作为“值”。将这些数字转换为关联的描述性文本。将DLookup()转换为表或进行硬代码转换。 3个单选按钮的示例,其OptionValue为1、2、3:Choose(Me.optGender, "Female", "Male", "Not Given")

© www.soinside.com 2019 - 2024. All rights reserved.