表格字段描述 - MS Access

Question

我查看了一些关于如何从字段的“描述”框中获取描述的VBA代码，但不知道如何在表单属性中使用它。

我想让一个控制提示出现，显示从数据库中提取的该字段的描述，而无需重新编写所有的描述；我希望能够复制粘贴一小段代码，将其添加到所有的控制提示中。

类似于以下代码（但显然不是这样）

ControlTipText:  Me.ThisControl.ThisControlFieldDescription

有人知道这个代码吗，或者它是否存在？

编辑：

description = Forms("frmTrials").Controls("txtBox").StatusBarText
MsgBox description

以上内容是展示状态栏文本的方法。然而，我想要将“frmTrials”填充为活动窗体，“txtBox”填充为当前活动控件；这样当控件变为活动状态时，我就可以将StatusBarText放入“描述框”文本字段（或控件提示等）。我尝试过

description = Forms(Me).Controls(Me.ActiveControl).StatusBarText

它刚才向我报错了。

- StuckAtWork

---

通常情况下，描述会出现在状态栏中，你也希望它出现在控制提示中吗？ - Fionnuala

Answer 1

据我所了解，您希望每次加载表单时动态设置“ControlTipText”属性。由于您在评论中指出该应用程序旨在用于平板设备，因此您可能希望在打开表单时限制处理器负载。您可以通过将“ControlTipText”属性与表单设计一起保存来实现这一点。

请按以下步骤使用您的表单名称：

SetControlTipText "YourFormName"

以下是步骤。在有限测试中没有发现问题。它为复选框、组合框、列表框和文本框设置了ControlTipText。更改第一个Case行以定位不同的控件集。

Public Sub SetControlTipText(ByVal pFormName As String)
    Dim ctl As Control
    Dim db As DAO.Database
    Dim frm As Form
    Dim rs As DAO.Recordset

    DoCmd.OpenForm pFormName, acDesign
    Set frm = Forms(pFormName)
    If Len(frm.RecordSource) > 0 Then
        Set db = CurrentDb
        Set rs = db.OpenRecordset(frm.RecordSource)
        For Each ctl In frm.Controls
            Select Case ctl.ControlType
            Case acCheckBox, acComboBox, acListBox, acTextBox
                If Len(ctl.ControlSource) > 0 _
                        And Not ctl.ControlSource Like "=*" Then
                    ctl.ControlTipText = _
                        GetDescription(rs.Fields(ctl.ControlSource))
                End If
            Case Else
                ' pass '
            End Select
        Next ctl
        rs.Close
    End If
    Set ctl = Nothing
    Set rs = Nothing
    Set db = Nothing
    Set frm = Nothing
    DoCmd.Close acForm, pFormName, acSaveYes
End Sub

SetControlTipText 调用此函数：

Public Function GetDescription(ByRef pObject As Object) As String
    Dim strReturn As String

On Error GoTo ErrorHandler

    strReturn = pObject.Properties("Description")

ExitHere:
    GetDescription = strReturn
    On Error GoTo 0
    Exit Function

ErrorHandler:
    strReturn = vbNullString ' make it explicit '
    GoTo ExitHere
End Function

如果未绑定窗体，则该SetControlTipText过程将被忽略。如果绑定字段的控件源没有分配Description属性，则其ControlTipText将设置为空字符串。

此方法将要求您仅为窗体运行一次该过程，而不是每次加载窗体时运行其他某些过程。如果以后更改表单记录源字段的任何Description属性，则可以重新运行SetControlTipText以更新ControlTipText。

或者，在发布应用程序的新版本之前，您可以为所有应用程序窗体运行该过程。

Dim frm As Object
For Each frm in CurrentProject.AllForms
    SetControlTipText frm.Name
Next frm

- HansUp

---

标记为答案，因为我相信它回答了我的原始问题。最终我采取了不同的方向（一个文本字段，在鼠标悬停在控件上时填充），所以我没有测试这个，但它确实给了我一些变量/方法，我已经实现了它们。 - StuckAtWork

Answer 2

您可以尝试以下变体，遍历表单上的所有控件，并将它们的工具提示设置为与绑定数据源匹配的字段。

Private Sub Form_Load()
    ' Load tooltips for the current form '
    ' Place this in all subforms as well '
    SetToolTips Me
    ' If the form is bound at runtime, you can call use instead '
    SetToolTips Me, myDataRecordSet
End Sub

Private Sub SetToolTips(frm As Form, Optional rs As dao.Recordset)
    Dim ctls As Controls
    Dim ctl As Control
    Dim sourceField As String
    Dim description As String

    On Error Resume Next

    Set ctls = frm.Controls
    If rs Is Nothing Then Set rs = frm.Recordset

    For Each ctl In ctls
        sourceField = ctl.ControlSource
        If Len(sourceField) > 0 Then
            description = rs.Fields(sourceField).Properties("Description")
            If Len(description) > 0 Then
                ctl.ControlTipText = description
            End If
        End If
    Next ctl
    Set ctls = Nothing
End Sub

- Renaud Bompuis

---

@Remou，同意，但这可能是开发人员无法控制的要求。 - Renaud Bompuis

我计划将其作为可用于平板电脑的应用程序推出，因此我使用弹出式表单来最小化屏幕空间；整个程序打开时带有状态栏太多了。此外，有些表单具有非常长且必要的描述，因此如果我可以将控件提示设置为它，我就可以将任何内容设置为它（制作动态描述框等）。 - StuckAtWork

这是非常优雅、漂亮的代码。谢谢！我现在会尝试它。 - StuckAtWork

似乎ctl.ControlSource存在某种逻辑错误。我进行了一些MsgBox调试，发现ctl.ControlSource似乎没有返回任何内容（对于VBA还不熟悉，所以使用MsgBox来显示值）。因此，Len()语句永远不会执行。 - StuckAtWork

@user1394455，该代码在很大程度上依赖于On Error Resume Next的功能。只有可以绑定到数据的控件才具有ControlSource。同样，如果sourceField包含类似于=[Price]*[Quantity]的语句，则.Fields(sourceField)可能无效。在这种情况下，代码将失败，但它不会显示错误，而是继续执行下一行。因此，我们基本上可以忽略这些错误，因为它们不会为我们的工具提示产生任何数据。 - Renaud Bompuis

Answer 3

最终使用文本字段来显示描述，而不是控件提示。如果给定文件夹中有信息图片（如果有的话），我也会让它出现。需要注意的是，我没有为非PNG格式的图像设置任何处理方式，但我相信这可以添加。

Public Function pushInfo(frm As Form)
'On Error Resume Next
Dim desc As String 'description from the status bar of the active control
Dim path As String 'path to image
Dim dbPath As String 'path to the database
Dim hyperPath As String 'path to hyperlink

'Take the statusbar text and push it into the description box caption.
desc = Forms(frm.Name).Controls(frm.ActiveControl.Name).StatusBarText 'Put statusbar text into var "desc"
frm.txtInfo.Caption = vbNewLine & vbNewLine & desc 'Put the text (with linefeeds) into the box
frm.lblInfo.Caption = frm.ActiveControl.Name & " Description:" 'Put the database name of the field into the label

'Set the image in the imgbox
dbPath = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))   'path to the DB.
path = dbPath & "img\" 'add the img directory
path = path & frm.Name & "\" 'add the form name
path = path & frm.ActiveControl.Name 'add the control's name
path = path & ".png" 'add the jpg suffix
hyperPath = path

If (Len(Dir(path)) = 0) Then 'if the image doesn't exist (this field has no image..)
    path = dbPath & "img\GenericLogo.png" 'set to the logo
    hyperPath = ""
End If

Forms(frm.Name).Controls("imgInfo").Picture = path 'set the picture to the defined path
Forms(frm.Name).Controls("imgInfo").HyperlinkAddress = hyperPath 'set the picture to link to the file
End Function

- StuckAtWork