Сохранение одной и той же книги под другим именем с помощью кнопки на 2 разных вкладках - PullRequest
Новая
       4

Сохранение одной и той же книги под другим именем с помощью кнопки на 2 разных вкладках

0 голосов
/ 02 апреля 2020

может кто-нибудь подскажет, что не так с моим кодом.

Работает, работает. Однако это не спасает так, как мне нужно. У меня есть эта книга с различными вкладками, и на 2 из этих вкладок у меня есть кнопка «Сохранить файл» (с почти таким же изменением нескольких вещей, таких как имя файла, который предполагается сохранить, например) ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & ".xls" и ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & " (Level 2)" & ".xls"

Моя проблема, если кнопка на вкладке 2 сохраняет файл Excel в верхней части уже существующего файла. Мне нужно, чтобы сохранить новый файл Excel и не на вершине уже существует. например. кнопка на вкладке 1 сохранит файл как предупреждение + дата , кнопка на вкладке 2 потребуется для сохранения нового файла с именем предупреждение + дата + (уровень 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: изменение кода должно быть на вкладке 2, вкладка, которая будет сохранять имя как Предупреждение и дата дня & (Уровень 2) , поскольку перед сохранением в этом файле будет храниться вся информация о предыдущем файле, а также новая информация на самой вкладке.

1 Ответ

0 голосов
/ 02 апреля 2020

вот код, который я мог бы получить из ваших комментариев 

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 "файл уже на месте

  • внес некоторые изменения в другие части, чтобы иметь (возможно) более читаемый эффективный и многократно используемый код

...