如何在vba excel中添加附件按钮

Question

我在 excel VBA 上开发了一个小型票务系统 Save 按钮将从文本框和单选按钮中获取所有数据并将其添加到第 7 行（在这种情况下） 但是当我按下上传时，我无法将链接添加到附件标签

如何使用（上传文件）按钮将链接添加到附件标签 并保存上传文件按钮中存储的链接值，以便稍后在清除按钮和保存按钮中使用？

我对使用私有 sub 和私有 dim 变量感到困惑。 我是VBA新手，请帮忙

System of Ticketing

上传按钮

Public Sub btnAttachment_Click()

'To upload file link format is png, jpeg, PDF or All files'

Dim wks As Worksheet
Dim LinksList As Range
Dim lastRowLink As Long
Dim LinkAttached As Long

Set wks = ActiveSheet

Set LinksList = Range("N1")


'declare last row to insert link to
lastRowLink = WorksheetFunction.CountA(Sheets("Tickets").Range("A:A"))
 Sheets("Tickets").Cells(lastRow + 1, 11).Value = LinkAttached
 

    ChDrive "C:\"
    ChDir "C:\"
    Filt = "PNG Files(*.png),*.png ," & _
            "Jpeg Files(*.jpeg),*.jpg ," & _
            "PDF Files (*.pdf),*.pdf ," & _
            "All Files (*.*),*.*"
    FilterIndex = 1
    Title = "Select a File to Hyperlink"
    Filename = Application.GetOpenFilename _
        (FileFilter:=Filt, _
         FilterIndex:=FilterIndex, _
         Title:=Title)

    If Filename <> False Then
       wks.Hyperlinks.Add Anchor:=LinksList, _
       Address:=Filename, _
        TextToDisplay:=Filename
    Else
        MsgBox "No file was selected.", vbCritical, "Loading Error"
        Exit Sub
    End If
End Sub

保存按钮代码

Public Sub BtnSave_Click()

    Dim Ws As Worksheet
    Dim lastRow As Long
    Dim openOn As Date
   
    
    'Declare openBy to date Now function'
    openOn = Now()
    'set format function on time var'
    openTimeAmPM = Format(openOn, "m.d.yy h:mm AM/PM")
    'if no all information required inserted, show error'
    If SieraForum.txtTicketName.Value = "" Or (SieraForum.ErrorOption = False And SieraForum.OrderOption = False) Or SieraForum.CombLocation.Value = "" Or SieraForum.CombOpenBy.Value = "" Or SieraForum.CombTicketStatus.Value = "" Then
    MsgBox " Please fill All information required (Ticket Name, Severity, Location, OpenBy)"

    Else
    lastRow = WorksheetFunction.CountA(Sheets("Tickets").Range("A:A"))
    
    Sheets("Tickets").Cells(lastRow + 1, 1).Value = lastRow
    Sheets("Tickets").Cells(lastRow + 1, 2).Value = SieraForum.txtTicketName.Value
    
    If SieraForum.ErrorOption = True Then
     Sheets("Tickets").Cells(lastRow + 1, 3).Value = "Error"
    Else
     Sheets("Tickets").Cells(lastRow + 1, 3).Value = "Order"
    End If
       
    Sheets("Tickets").Cells(lastRow + 1, 4).Value = SieraForum.CombSeverity.Value
    Sheets("Tickets").Cells(lastRow + 1, 5).Value = SieraForum.CombLocation.Value
    Sheets("Tickets").Cells(lastRow + 1, 6).Value = SieraForum.txtTicketDetails.Value
    Sheets("Tickets").Cells(lastRow + 1, 7).Value = SieraForum.CombOpenBy.Value
    Sheets("Tickets").Cells(lastRow + 1, 8).Value = SieraForum.CombCloseBy.Value
    Sheets("Tickets").Cells(lastRow + 1, 9).Value = SieraForum.CombTicketStatus.Value
    Sheets("Tickets").Cells(lastRow + 1, 10).Value = openTimeAmPM
    
    'Sheets("Tickets").Cells(lastRow + 1, 13).Value =
    
    
    'Display new ticket number on the label'
    lbTicketNumVal.Caption = lastRow
   End If
  
  'to clear data after pressing Save button'
  
'Clear the data from the form'
SieraForum.txtTicketName.Value = ""
SieraForum.ErrorOption = False
SieraForum.OrderOption = False
SieraForum.CombSeverity = ""
SieraForum.CombLocation = ""
SieraForum.txtTicketDetails = ""
SieraForum.CombOpenBy = ""
SieraForum.CombCloseBy = ""
SieraForum.CombTicketStatus = ""
lbTicketNumVal.Caption = lastRow + 1
   
    
'to save excel sheet editing'
ActiveWorkbook.Save

     
End Sub

Answer 1

如果我的理解正确，该行将已经存在于工作表中。对于上传，您只需要使用链接文件名更新该行。也可以有多个链接。

在btnAttachment_Click()的底部，添加这段代码：

rw = SieraForum.lbTicketNumVal.Caption   ' ticket number label
' append filename to cell value
Sheets("Tickets").Cells(rw, 13).Value = Sheets("Tickets").Cells(rw, 13).Value & vbcrlf & Filename

假定第 13 (M) 列是您要更新的链接列。它从工单标签中获取行号。