如何在单击超链接“发送”时自动保存并关闭 excel 文件

如何在单击超链接“发送”时自动保存并关闭 excel 文件

我有这个代码可以自动填充主题:在 Outlook 邮件中根据单元格值。

Range("G5").Select
ActiveCell.FormulaR1C1 = "=HYPERLINK(""mailto:?subject="" & RC[-6] & "" - "" & RC[-1] ,""send"")"
Selection.AutoFill Destination:=Range("G5:G1500"), Type:=xlFillDefault

我的问题是,在宏中,当用户单击超链接时,excel 文件是否会自动保存并关闭它?

如果可能的话,我该如何将其添加到我的代码中?

笔记:点击超链接时发送Outlook 邮件将会弹出。


代码位于创建新文件当我运行宏时,它将保存一个新的 excel 文件,并且该宏上写的所有命令或代码都将应用于新的 excel 文件。


这是我的宏的完整代码

Sub create()
Dim myvalue As Variant

myvalue = InputBox("Input Current Year: 'YYYY'", "Request Registry")
If myvalue = vbNullString Then

Else
    Call req(myvalue)
End If
End Sub
--------------------------------------------
Private Function req(myvalue As Variant)

Dim saveFolder As String

saveFolder = "C:\Document\Macro"

Workbooks.Open "C:\Document\Request.xlsm"
Sheets("Sheet1").Copy

Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Visible = False

Cells.Select

Range("A1").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Contains EW Confidential Information"

Range("B:B, K:K, M:M").Select
Selection.NumberFormat = "m/d/yyyy"

Range("L:L").Select
Selection.NumberFormat = "0"

Range("A3").Select
ActiveCell.FormulaR1C1 = "Requested ID (REQ-" & myvalue & "-###)"
Range("B3").Select
ActiveCell.FormulaR1C1 = "This portion is to be filled up by requester"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Date of Actual Request (Cut-off 3PM)"
Range("C4").Select
ActiveCell.FormulaR1C1 = "Requested by"
Range("D4").Select
ActiveCell.FormulaR1C1 = "Requester's Department"
Range("E4").Select
ActiveCell.FormulaR1C1 = "Engagement"
Range("F4").Select
ActiveCell.FormulaR1C1 = "Nature of Request"
Range("G3").Select
ActiveCell.FormulaR1C1 = "Send Request"
Range("H4").Select
ActiveCell.FormulaR1C1 = "Assigned to"
Range("I4").Select
ActiveCell.FormulaR1C1 = "Status"
Range("J4").Select
ActiveCell.FormulaR1C1 = "Remarks"
Range("K4").Select
ActiveCell.FormulaR1C1 = "Date Tagged"
Range("L4").Select
ActiveCell.FormulaR1C1 = "Days Elapsed"
Range("M3").Select
ActiveCell.FormulaR1C1 = "Actual Date Delivered"

Range("G5").Select
ActiveCell.FormulaR1C1 = "=HYPERLINK(""mailto:?subject="" & RC[-6] & "" - "" & RC[-1] ,""send"")"
Selection.AutoFill Destination:=Range("G5:G1500"), Type:=xlFillDefault

'Auto save and close code
Dim answer As VBA.VbMsgBoxResult
answer = MsgBox("Job complete?", vbYesNo + vbQuestion, "Pls. Confirm")
If answer = vbNo Then Exit Sub
ActiveWorkbook.Close SaveChanges:=True

rng = "A5:M1500"
Range(rng).Select
With Selection
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeLeft).Weight = xlThin
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeTop).Weight = xlThin
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).Weight = xlThin
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeRight).Weight = xlThin
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideVertical).Weight = xlThin
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).Weight = xlThin
    .VerticalAlignment = xlCenter
End With

Range("A5").Select
ActiveCell.FormulaR1C1 = "REQ-" & myvalue & "-000"
Selection.AutoFill Destination:=Range("A5:A1500"), Type:=xlFillDefault

ActiveSheet.Name = "Request"

ActiveWorkbook.SaveAs saveFolder & "\Request.xlsx", FileFormat:=51
ActiveWorkbook.Close

结束函数

答案1

自动填充后将这些代码添加到现有宏中,将在保存并关闭工作簿之前提示您。

Dim answer As VBA.VbMsgBoxResult

answer = MsgBox("Job complete?", vbYesNo + vbQuestion, "Pls. Confirm")

If answer = vbNo Then Exit Sub
ActiveWorkbook.Close SaveChanges:=True

相关内容