保存到用户的下载文件和更新文件，而不弹出窗口要求覆盖

Question

现在，VBA 宏在“我的”PC 上运行得很好，我将其作为特定文件保存到我的下载文件夹中。 我需要它在运行此宏并具有相同功能的其他人的电脑上工作。 我尝试用谷歌搜索，但没有找到我需要的东西。

下面是我正在使用的代码：

Sub UnLoad_UnPick()
'
' UnLoad_UnPick Macro
'

'
Range("Q:Q").Style = "CURRENCY"


Columns("O:O").Select
    Selection.Cut

Columns("A:A").Select
    Selection.Insert Shift:=xlToRight

Range("A1").Select

Application.DisplayAlerts = False
     ChDir "C:\\users\"1st name"."last name"\downloads"
     ActiveWorkbook.SaveAs Filename:= _
          "C:\users\"1st name"."last name"\downloads\Transaction_Details.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
'
End Sub

Answer 1

可以通过多种方式改进您的代码，其中一些是：

• 错误处理 - 添加了

  On Error GoTo ErrorHandler

  块来优雅地处理任何运行时错误。
• 删除了不必要的

  Select

  语句，使代码更干净、更快。
• 添加了一个消息框，通知用户文件的保存位置。
• 仅格式化 Q 列中的相关单元格，而不是整个列：

Sub UnLoad_UnPick()

    Dim lastRow As Long
    Dim downloadsPath As String
    ' Get the current user's Downloads folder path
    ' (or use another method as suggested above)
    downloadsPath = Environ("USERPROFILE") & "\Downloads"

    On Error GoTo ErrorHandler

    ' Format only the relevant cells in column Q
    lastRow = Cells(Rows.Count, "Q").End(xlUp).Row
    If lastRow > 1 Then
        Range("Q2:Q" & lastRow).Style = "Currency"
    End If

    Columns("O:O").Cut
    Columns("A:A").Insert Shift:=xlToRight
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=downloadsPath & "\Transaction_Details.xlsx", _
                          FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True

    MsgBox "The file has been saved successfully in: " & downloadsPath, vbInformation, "Save Successful"

    Exit Sub

ErrorHandler:
   
    Application.DisplayAlerts = True
    MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
End Sub