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

Posted 2023-05-07

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

【英文标题】：Saving the same workbook with different name using button in 2 different tabs

【发布时间】：2020-04-02 08:39:22

【问题描述】：

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

它有效。但是，它并不能保存我需要的方式。我有这个带有各种选项卡的工作簿，在其中 2 个选项卡中我有一个按钮“保存文件”（几乎相同，更改了一些文件应该保存的名称，例如）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) 的新文件。

我的选项卡警报和日期和（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

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

PS：代码上的改动需要在tab2上，这个选项卡会保存名字为Alert & date of the day & (Level 2)，因为这个文件会包含所有的以前文件的信息加上保存前自身选项卡上的新信息。

【问题讨论】：

对我来说有点困惑......您可能对代码的磨损情况更具描述性：它实际上在做什么是不正确的，在哪些情况下？

@HTH 我不确定出了什么问题。我需要它来保存一个新的 excel 文件而不是上面已经存在的。例如。 tab1 上的按钮将文件保存为 Alert +date，tab2 上的按钮需要保存一个名为 Alert + date + (Level 2) 的新文件。

tab2 上的按钮实际上在做什么？

它保存在已经作为更新存在的文件的顶部。

所以您需要在同一日期多次使用 tab 2 按钮，不是吗？

【参考方案1】：

这是我可以从你的 cmets 中得到的代码

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”文件已经存在，请注意添加时间戳到位

对其他部分进行了一些修改，以（可能）获得更易读、更高效且可重用的代码

【讨论】：

谢谢，我正在尝试。在if ClientReview.Visible then 行中出现错误：运行时“91”对象变量或未设置块变量。

这意味着你必须Set ClientReview = … 但我不知道除此之外它可能是一个工作表。但是我留下的那部分代码保持原样，所以如果你的代码在它必须再次工作之前工作。

谢谢，太好了。输入我需要的名称，一切正常。它也节省了时间（所以我会接受它，因为我不需要它）。