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

Question

也许有人能看出我的代码有什么问题。

有效有效。但是，它并没有保存我需要的方式。我有这个带有各种选项卡的工作簿，在这个选项卡的 2 个中，我有一个按钮 "Save File"（几乎相同，改变了一些东西作为文件应该保存的名称，例如）ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & ".xls" 和ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & " (Level 2)" & ".xls"

我的问题是 tab2 上的按钮是否将 excel 文件保存在已存在文件的顶部。我需要它来保存一个新的 excel 文件，而不是在已经存在的文件之上。例如。 tab1 上的按钮会将文件保存为 Alert +date，tab2 上的按钮需要保存一个名为 Alert + date + (Level 2)[ 的新文件=28=]。

我的警报和日期标签代码（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") & "\Desktop\Investigations" 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 & "\Desktop\Investigations", vbDirectory)) = 0 Then MkDir (savePath & "\Desktop\Investigations") End If ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & " (Level 2)" & ".xls" Exit Sub End Sub

对于 "Save File button" 我应该在哪里更改以将相同的 excel 文件保存为不同名称的新文件而不是保存在现有文件的顶部？

PS：代码的更改需要在 tab2 上，该选项卡将名称保存为 Alert & date of the day & (Level 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") & "\Desktop\Investigations" 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 & "\Desktop\Investigations", vbDirectory)) = 0 Then MkDir (savePath & "\Desktop\Investigations")


    '------------
    Dim fullName As String
    fullName = savePath & "\Desktop\Investigations\" & companyName & " " & today & " (Level 2)" & ".xls"

    If Dir(fullName) <> vbNullString Then fullName = savePath & "\Desktop\Investigations\" & companyName & " " & today & " (Level 2)" & Format(Time, "hhmmss") & ".xls"

    ActiveWorkbook.SaveCopyAs Filename:=fullName
    '------------


End Sub

我在哪里

警告您有一行正在系统地覆盖 ThisWorkbook
添加了最后一个代码块（包含在“------------”注释行之间）注意添加一个小时戳应该是“...Level2 " 文件已经存在
对其他部分进行了一些修改，以（可能）具有更易读、更有效和可重用的代码

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

Saving the same workbook with different name using button in 2 different tabs

excel

vba

save