使用两个不同选项卡中的按钮保存具有不同名称的同一工作簿

Question

也许有人能告诉我的代码出了什么问题。

它有效。然而，这并不能拯救我所需要的方式。我有一个带有各种选项卡的工作簿，其中两个选项卡中有一个按钮"保存文件"(与应该保存文件的名称几乎相同，只更改了一些内容，例如(ActiveWorkbook.SaveCopyAs Filename:=savePath & "DesktopInvestigations" & CompanyName & " " & today & ".xls"和ActiveWorkbook.SaveCopyAs Filename:=savePath & "DesktopInvestigations" & CompanyName & " " & today & " (Level 2)" & ".xls"

我的问题是，如果选项卡2上的按钮是在现有文件的顶部保存excel文件。我需要它来保存一个新的excel文件，而不是在已经存在的顶部。例如，选项卡1上的按钮将文件保存为警报+日期，选项卡2上的按钮需要保存一个名为Alert+date+(Level 2(的新文件。

我的选项卡Alert&日期&(2级(为：

Sub Save_Level_2_File()
If ClientReview.Visible = True Then
Set Client = ClientReview
Else
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "Client Review*" Then
Set Client = ws
End If
Next ws
End If
If Application.ActiveWorkbook.Path = Environ("userprofile") & "DesktopInvestigations" Then
ActiveWorkbook.Save
End If
Dim today As String
Dim savePath As String
Dim CompanyName As String
Dim UserName As String
Alert1.Activate
today = Format(Date, "MM.DD.YYYY")
Range("B4").Value = today
With Range("B4")
.Font.Color = .Interior.Color
End With
UserName = Application.UserName
Alert1.Visible = xlSheetVisible
Alert1.Activate
Range("C1").Value = UserName
Alert1.Name = "Alert " & today & " (Level 2)" 
If Len(Dir(savePath & "DesktopInvestigations", vbDirectory)) = 0 Then
MkDir (savePath & "DesktopInvestigations")
End If
ActiveWorkbook.SaveCopyAs Filename:=savePath & "DesktopInvestigations" & CompanyName & " " & today & " (Level 2)" & ".xls"
Exit Sub
End Sub

我应该在哪里更改"保存文件"按钮，以将同一excel文件保存为具有不同名称的新文件，而不是保存在现有文件的顶部？

PS：代码上的更改需要在选项卡2上，该选项卡将名称保存为Alert&当天的日期&(级别2(，因为在保存之前，此文件将具有上一个文件的所有信息以及自身选项卡上的新信息。

Answer 1

以下是我可以从您的评论中获得的代码

Sub Save_Level_2_File()

Dim Client As Worksheet, ClientReview As Worksheet, ws As Worksheet
If ClientReview.Visible Then
Set Client = ClientReview
Else
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "Client Review*" Then
Set Client = ws
Exit For
End If
Next ws
End If
If Application.ActiveWorkbook.Path = Environ("userprofile") & "DesktopInvestigations" Then ActiveWorkbook.Save ' <-- this will overwrite previous version

Dim today As String
Dim savePath As String
Dim companyName As String
Dim userName As String
Dim Alert1 As Worksheet
today = Format(Date, "MM.DD.YYYY")
userName = Application.userName
With Alert1
With .Range("B4")
.Value = today
.Font.Color = .Interior.Color
End With
.Visible = xlSheetVisible
.Range("C1").Value = userName
.Name = "Alert " & today & " (Level 2)"
End With
If Len(Dir(savePath & "DesktopInvestigations", vbDirectory)) = 0 Then MkDir (savePath & "DesktopInvestigations")

'------------
Dim fullName As String
fullName = savePath & "DesktopInvestigations" & companyName & " " & today & " (Level 2)" & ".xls"
If Dir(fullName) <> vbNullString Then fullName = savePath & "DesktopInvestigations" & companyName & " " & today & " (Level 2)" & Format(Time, "hhmmss") & ".xls"
ActiveWorkbook.SaveCopyAs Filename:=fullName
'------------

End Sub

何处

• 警告您有一行系统性地覆盖ThisWorkbook

• 添加了最后一个代码块(包含在"---------------"注释行之间(，如果"…Level2"文件已经在中，则负责添加小时戳

• 在其他部分进行了一些修改，以(可能(具有更可读、更高效和可重复使用的代码