Excel VBA如何将附件存入单元格及解决用户窗体文本框跳转异常

附件覆盖G2单元格修复 #

原代码将附件锚定单元格硬编码为G2，且空行计算逻辑存在变量未定义错误，修复后会自动匹配G列最后一个非空行的下一行写入附件链接，不会再覆盖历史内容。

文本框回车跳转顺序修复 #

需要先调整控件Tab顺序：打开窗体设计界面，依次选中textbox1、textbox2、textbox3，将属性栏的TabIndex值分别设置为0、1、2，再添加对应的回车跳转事件即可实现预期的导航逻辑。

完整修正代码 #

' 提交按钮点击事件
Private Sub SubmitButton_Click()
    Dim iRow As Long
    Dim wrkSht As Worksheet
    Set wrkSht = Worksheets("Sheet1")
    Dim emailApplication As Object
    Dim emailItem As Object
    
    ' 查找最后一个非空行的下一行作为写入行
    iRow = wrkSht.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

    If Trim(RequesterBox.Value) = "" Then
        RequesterBox.SetFocus
        MsgBox "请完成表单填写"
        Exit Sub
    End If
        
    wrkSht.Cells(iRow, 1).Value = RequesterBox.Value
    wrkSht.Cells(iRow, 2).Value = SquadronBox.Value
    wrkSht.Cells(iRow, 3).Value = EmailBox.Value
    wrkSht.Cells(iRow, 4).Value = PhoneBox.Value
    wrkSht.Cells(iRow, 5).Value = LocationBox.Value
    wrkSht.Cells(iRow, 6).Value = DescriptionBox.Value
        
    MsgBox "请求提交成功，我们将尽快与您联系", vbOKOnly + vbInformation, "提交成功"
    '----------------------- 发送邮件 -----------------------'
    
    Set emailApplication = CreateObject("Outlook.Application")
    Set emailItem = emailApplication.CreateItem(0)
    
    emailItem.To = "" ' 请在此处填写收件人邮箱
    
    emailItem.Subject = "场地申请"
    
    emailItem.Body = "收到新的场地申请，申请地点：" & LocationBox.Value & Chr(10) & _
                      "申请描述：" & Chr(10) & DescriptionBox.Value
    
    emailItem.Display
    
    Set emailItem = Nothing
    Set emailApplication = Nothing ' 修正原代码变量名错误
    
    ' 清空表单
    RequesterBox.Value = ""
    SquadronBox.Value = ""
    EmailBox.Value = ""
    PhoneBox.Value = ""
    LocationBox.Value = ""
    DescriptionBox.Value = ""
    RequesterBox.SetFocus
    
End Sub

' 附件上传按钮点击事件
Private Sub AttachButton_Click()
    Dim wrkSht As Worksheet
    Set wrkSht = Worksheets("Sheet1")
    Dim LinksList As Range
    Dim lastRowLink As Long
    Dim FileName As Variant
    Dim Filt As String, FilterIndex As Integer, Title As String
    
    ' 查找G列最后一个非空行的下一行作为附件写入位置
    lastRowLink = wrkSht.Cells(wrkSht.Rows.Count, "G").End(xlUp).Row + 1
    Set LinksList = wrkSht.Range("G" & lastRowLink)
  
    ChDrive "C:\"
    ChDir "C:\"
    Filt = "PNG文件(*.png),*.png," & _
            "JPG文件(*.jpg),*.jpg," & _
            "PDF文件(*.pdf),*.pdf," & _
            "所有文件(*.*),*.*"
    FilterIndex = 1
    Title = "选择要上传的文件"
    FileName = Application.GetOpenFilename _
        (FileFilter:=Filt, _
         FilterIndex:=FilterIndex, _
         Title:=Title)
    If FileName <> False Then
       wrkSht.Hyperlinks.Add Anchor:=LinksList, _
       Address:=FileName, _
       TextToDisplay:=FileName
       MsgBox "附件上传成功"
    Else
        MsgBox "未选择任何文件", vbCritical, "上传错误"
        Exit Sub
    End If

End Sub

' textbox1回车跳转事件
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If KeyAscii = 13 Then ' 13对应回车键
        KeyAscii = 0
        TextBox2.SetFocus
    End If
End Sub

' textbox2回车跳转事件
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If KeyAscii = 13 Then
        KeyAscii = 0
        TextBox3.SetFocus
    End If
End Sub

内容的提问来源于stack exchange，提问作者Fernando Piedra