如何在VBA Excel中添加附件按钮

如何解决如何在VBA Excel中添加附件按钮

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

如何使用（上传文件）按钮添加指向附件标签的链接 还要保存存储在上传文件按钮中的链接值，以便以后在清除按钮和保存按钮中使用它吗？

我很困惑使用私有子变量和私有暗变量。 我是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

解决方法

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

在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）是您要更新的链接列。它从票证标签获取行号。