Question

我无法在互联网上找到关于保存用户表单输入值的任何内容，它们会被加载。这是一个VBA问题。

我希望用户在设置页面的文本框中输入路径，并在每次加载用户窗体时使用此路径字符串。用户每次打开用户表单时都不必输入路径。如何使Excel VBA存储路径直到下次加载？

谢谢！

Answer 1

这是一种方式......

在像这样的标准模块上声明一个公共变量......

Public Path As String

然后在UserForm模块上有TextBox AfterUpdate事件的以下代码...

Private Sub TextBox1_AfterUpdate()
Path = TextBox1.Value
End Sub

Path变量将保存当前会话的TextBox1.Value，用户不需要再次在TextBox1中提供Path。

Answer 2

如果你有冒险精神，这里有一个让你高兴的解决方案。从标准代码模块开始。默认情况下，它将被称为Module1。将以下两个过程放在该模块中。您调用模块并不重要，但请确保不要使用ThisWorkbook代码模块，也不要使用工作表后面的任何代码模块。

函数“SavedDataFileName”是您声明要存储要记住的数据的位置的位置。您可以使用任何您喜欢的位置。代码指定了C:\Users\[Your Name]之类的位置。您也可以更改文件名。关键是所有这些都存储在一个地方，从那里读取文件和写入文件时。

Option Explicit

Function SavedDataFileName() As String
    ' create this as a function to be called by various parts of your code
    ' so that you don't have to repeat it in many places in case of future change

    SavedDataFileName = Environ("USERPROFILE") & "\SavedPath.txt"
End Function

下一个函数读取刚刚指定的文本文件。实际上，这是我准备好的代码。因此，它具有读取许多数据的能力。你只想读一个 - 路径。它会那样做。

Function TextFile(Ffn As String, _
                  MaxLines As Integer) As String()
    ' 17 Oct 2016

    Dim Fun() As String                             ' Function return
    Dim i As Integer
    Dim Fid As Integer                              ' File ID

    If Len(Dir(Ffn)) Then
        ReDim Fun(MaxLines)                         ' arbitrary maximum
        Fid = FreeFile()
        Open Ffn For Input As #Fid
        While Not EOF(Fid)
            Line Input #Fid, Fun(i)
            Fun(i) = Trim(Fun(i))
            i = i + 1
        Wend
        Close #Fid
        ReDim Preserve Fun(i - 1)
    End If
    TextFile = Fun
End Function

现在请转到您希望保留数据的表单的代码表。所有以下程序必须在该表格上。不要在其他任何地方安装它们。它们只能在特定代码表上安装时才能工作。

第一个过程在表单初始化时运行，这意味着在首次创建时 - 启动时。

Option Explicit

Private Sub UserForm_Initialize()
    ' 13 May 2017

    Dim SavedData() As String

    On Error GoTo EndRetrieval
    SavedData = TextFile(SavedDataFileName, 10)
    TextBox1.Text = SavedData(0)
    ' you can pre-load more controls in your form here
EndRetrieval:    
End Sub

在此子文档中打开文本文件并从中导入数据。预计最多10个数据。您可以将此数字设置得更高或更低。设置得越高，临时使用的内存空间就越多。您只需要1个数据项。这将具有索引号0（零），并将其分配给TextBox1。当然，你可以改变它。如果遇到错误，将不会执行任何操作，文本框仍为空白。

每当退出TextBox1时，下一个过程都将运行。当然，您可以更改其名称以引用另一个文本框。其目的是确保文本框包含有效的路径名。如果用户输入的内容不是有效名称，他将被告知。

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    ' 13 May 2017

    Dim Ffn As String                       ' Full file name

    Ffn = Trim(TextBox1.Text)
    On Error Resume Next
    MsgMe Dir(Ffn & "\", vbDirectory) & ", " & Len(Dir(Ffn & "\", vbDirectory))
    Cancel = (Len(Ffn) = 0) Or (Len(Dir(Ffn & "\", vbDirectory)) = 0)
    If Not Cancel Then Cancel = CBool(Err.Number)    ' in case Dir(Ffn) caused an error

    If Cancel Then
        MsgBox "The path you entered isn't valid." & vbCr & _
               "Please enter a valid path."
    Else
        TextBox1.Text = Ffn                ' removed leading/trailing blanks
    End If
End Sub

表单关闭时运行最终过程。它将TextBox1的当前设置写入文本文件，然后在下次加载表单时将其从中检索。

Private Sub UserForm_Terminate()
    ' 12 May 2017

    Open SavedDataFileName For Output As #1
    Print #1, TextBox1.Text
    ' you can write more data to be  remembered here
    Close #1
End Sub

此过程只将一行写入文本文件。如果要保存更多项目，只需在文件中打印更多值即可。请注意，未检查保存的数据质量。这是在输入之后完成的。如果用户设法将错误的路径走私到文本框中，那么错误的路径将在第二天早上回来困扰他。

Answer 3

我建议使用SaveSetting appname, section, key, setting存储数据和GetSetting appname , section, key [, default ]来检索值。

以您的示例为例：

Private Sub UserForm_Terminate()
    '
    ' Save Setting to the windows registry
    ' usually values are stored at the following path:
    ' Computer\HKEY_USERS\{user-guid}\Software\VB and VBA Program Settings
    '
    SaveSetting "YourApplication", "UserFormXYZ", "TextBox1", TextBox1.Text
End Sub

Private Sub UserForm_Initialize()
    dim defaultPath   As String
    dim userPath      As String
    ' set defaultPath as you require

    ' get settings from Registry
    userPath = GetSetting("YourApplication", "UserFormXYZ", "TextBox1", defaultPath)
    TextBox1.Text = userPath
End Sub

Answer 4

自定义文档属性怎么样？

除了@Ralph 的有效评论之外，我还想展示一种经常不被考虑的方式：将值直接存储到自定义文档属性 (CDP) 中：

用户表单代码部分（一）——事件程序

UserForm_Activate() 只是在用户表单的任何激活时重新显示存储的值。
TextBox1_Exit() 将任何路径值更改立即存储到 CDP MyPath

Option Explicit

Private Sub UserForm_Activate()
'Purp.: Display (stored) MyPath value on activation
    'MsgBox "Current value of MyPath = " & MyPath
    'display current value in textbox
    Me.TextBox1 = MyPath
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    '(only for comparison)
    Dim OldPath As String
    OldPath = MyPath
    '~~~~~~~~~~~~~~~~~~~~~~~~
    'store changed Path value
    '~~~~~~~~~~~~~~~~~~~~~~~~
    MyPath = Me.TextBox1
    MsgBox "Changed MyPath " & vbNewLine & _
           "from: " & OldPath & vbNewLine & _
           "to:   " & MyPath
End Sub

用户表单代码部分 (2) - CDP 相关

由于任何用户窗体仅代表一种特殊的类，您甚至可以在用户窗体代码模块中使用 Get/Let 属性以及检查有效性的布尔函数。

以下代码不打算展示最好的，而只是展示进一步通往罗马的道路。

'Get-/Let-Properties
Private Property Get MyPath() As Variant
    Const STOREDPATH As String = "MyPath"
    Dim cdps As DocumentProperties
    Set cdps = ThisWorkbook.CustomDocumentProperties
    If CDPExists(STOREDPATH) Then MyPath = cdps.Item(STOREDPATH)
End Property

Private Property Let MyPath(ByVal CDPValue)
    Const STOREDPATH As String = "MyPath"
    Dim cdps As DocumentProperties
    Set cdps = ThisWorkbook.CustomDocumentProperties

    If Not CDPExists(STOREDPATH) Then
        cdps.Add Name:=STOREDPATH, LinkToContent:=False, Type:=msoPropertyTypeString, Value:=CDPValue
    Else
        cdps.Item(STOREDPATH) = CDPValue
    End If
End Property

Private Function CDPExists(CDPName As String) As Boolean
' Purp.: return True|False if Custom Document Property (CDP) name exists
' Meth.: loop thru CustomDocumentProperties and check for existing sCDPName parameter
' Site : https://stackoverflow.com/questions/41766268/check-if-builtindocumentproperty-is-set-without-error-trapping
    Dim cdps As DocumentProperties
    Set cdps = ThisWorkbook.CustomDocumentProperties
    Dim boo  As Boolean                               ' boolean value showing element exists
    Dim cdp  As DocumentProperty                      ' element of CustomDocumentProperties Collection
    For Each cdp In cdps
        If LCase(cdp.Name) = LCase(CDPName) Then
            boo = True                                ' heureka
            Exit For                                  ' exit loop
        End If
    Next
    CDPExists = boo                                   ' return value to function
End Function

相关链接

类似于最后一个函数检查自定义 doc props，一个相关的长者帖子对待Check if built-in doc property is set without error trapping

VBA Userform保存下次的值

4 个答案: