跳转至内容

应用程序 VBA/关闭时备份文本框

来自维基教科书,自由的教学读物

此 VBA 代码是为 Microsoft Excel 编写的,但可以轻松地适应 MS Office 套件中的其他应用程序。它在每次关闭窗体时将用户窗体文本框中的所有文本保存到日志文件中。然后,稍后在重新打开窗体时,或在任何其他时间,用户可以使用最近保存的文本填充文本框。

VBA 代码

[编辑 | 编辑源代码]
  • 该代码需要一个名为 Userform1 的用户窗体,两个文本框,TextBox1 和 TextBox2,以及一个名为 CommandButton1 的命令按钮。将 UserForm1 属性 ShowModal 设置为 false 以方便学习。将下面的代码复制到三个相应的模块中,并使用 xlsm 文件后缀保存工作簿。
  • 文本框中找到的任何代码都将在用户窗体关闭时保存。这包括用户窗体的无意关闭或工作簿的故意关闭。当然,它不保护用户免受电源故障的影响。数据的保存无需人工干预,因此如果要避免敏感数据的存储,则需要考虑这一点。
  • 日志文件名为 SavedText.txt,它将位于与工作簿相同的文件夹中。如果未找到该名称的日志文件,则代码会创建它以供使用。日志文件只有两个字段,文本框名称和其中找到的字符串内容。逗号分隔符被避免,因为它不太可能遇到字符串 >Break<
  • 保存功能从 UserForm_QueryClose 事件运行。SaveTextBoxes() 在用户窗体控件循环中创建日志字符串,然后通过 WriteToFile() 导出字符串。
  • WriteToFile() 会在不存在日志文件时创建日志文件,但否则会覆盖找到的任何文本,因此只有最近保存的会话会保留在那里。在其他地方使用日志记录过程的用户应注意,在记录条目末尾额外存储了 CrLf,可能需要考虑。
  • RestoreTextBoxes() 仅通过按 CommandButton1 运行,因此用户可以选择是否插入文本。GetAllFileText() 一次导入所有日志文件的内容,文件保留内容直到下次被覆盖。字符串被拆分两次,一次是将其分成行,即每个文本框记录一行,然后再次将每个记录分成两个字段以匹配主传输循环中的控件名称。

代码变更

[编辑 | 编辑源代码]

2019 年 3 月 8 日:将数据分隔符从逗号更改为其他符号,在标准模块中

对于 ThisWorkbook 模块

[编辑 | 编辑源代码]
'...............................................
' Notes: Code needs a user form named UserForm1,
' with two text boxes, TextBox1 and Textbox2,
' and a command button with name CommandButton1.
' Set UserForm1 property ShowModal to False 
'...............................................

Private Sub Workbook_Open()
    'Runs on opening the workbook
   
    Load UserForm1
    UserForm1.Show

End Sub

对于 Userform1 模块

[编辑 | 编辑源代码]
Private Sub CommandButton1_Click()
    ' Restores saved textbox text
    ' after reopening the user form
    
    ' restores textbox text from file
    RestoreTextBoxes
    
    'set insertion point to TextBox1
    With TextBox1
        .SelStart = Len(.Value) 'to end of text
        .SelLength = 0          'just insertion
        .SetFocus
    End With

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ' Runs before closing the userform
    ' Used here to save textbox values in a log file

    SaveTextBoxes
    
End Sub

对于标准模块

[编辑 | 编辑源代码]
Option Explicit

Sub SaveTextBoxes()
    ' Saves values from user form text boxes to a log file
    ' Data is never lost while log file exists
    ' Runs in the UserForm_QueryClose() event at all times.
        
    Dim oForm As UserForm, oCont As Control, sStringOut As String
    Dim bCont As Boolean, sPath As String, sLogPath As String
    Dim sType As String
    
    Set oForm = UserForm1
    sPath = Application.ThisWorkbook.Path
    sLogPath = sPath & "\" & "SavedText.txt" 'log file address
    sType = "TextBox"
    
    'step through the form controls to find the textboxes
    For Each oCont In oForm.Controls
        If TypeName(oCont) = sType Then
            sStringOut = sStringOut & oCont.Name & ">Break<" & oCont.Value & vbCrLf
        End If
    Next oCont
    
    'remove tailend Cr and Lf
    sStringOut = Left$(sStringOut, Len(sStringOut) - 2)
    
    'send textbox string to the log file
    WriteToFile sStringOut, sLogPath
        
    'release object variables
    Set oForm = Nothing
    Set oCont = Nothing

End Sub

Function WriteToFile(ByVal sIn As String, ByVal sPath As String) As Boolean
    ' REPLACES all content of a text file with parameter string
    ' Makes the file if it does not exist
    ' Assumes that all formatting is already in sIn
    ' Note that this log file will add Cr and Lf to the stored string
    
    Dim Number As Integer
    
    Number = FreeFile 'Get a file number
    
    'write string to file
    Open sPath For Output As #Number
    Print #Number, sIn
    Close #Number

    WriteToFile = True
    
End Function

Sub RestoreTextBoxes()
    ' Restores saved values to user form text boxes.
    ' Data is never lost while log file exists.
    ' Runs when CommandButton1 is pressed
        
    Dim oCont As Control, oForm As UserForm
    Dim vA As Variant, vB As Variant, sRet As String
    Dim sPath As String, sLogPath As String, nC As Long
    
    Set oForm = UserForm1
    sPath = Application.ThisWorkbook.Path
    sLogPath = sPath & "\" & "SavedText.txt"
    
    'get text from the log file
    GetAllFileText sLogPath, sRet
    
    'remove the extra Cr and Lf added by the log file
    sRet = Left(sRet, Len(sRet) - 2)
    
    'step through controls to match up text
    vA = Split(sRet, vbCrLf)
    For nC = LBound(vA, 1) To UBound(vA, 1)
        'MsgBox Asc(vA(nC))
        vB = Split(vA(nC), ">Break<")
            For Each oCont In oForm.Controls
                If oCont.Name = vB(0) Then
                    oCont.Value = vB(1)
                End If
            Next oCont
    Next nC
   
    'release object variables
    Set oForm = Nothing
    Set oCont = Nothing

End Sub

Function GetAllFileText(ByVal sPath As String, sRet As String) As Boolean
    ' Returns entire log file text in sRet
    ' Note that this log file will add Cr and Lf to the original string
    
    Dim Number As Integer

    'get next file number
    Number = FreeFile

    'Open file
    Open sPath For Input As Number

    'get entire file content
    sRet = Input(LOF(Number), Number)
    
    'Close File
    Close Number

    'transfers
    GetAllFileText = True

End Function
[编辑 | 编辑源代码]
华夏公益教科书