Results 1 to 2 of 2

Thread: BeforeSave Event SaveCopyAs

  1. #1

    BeforeSave Event SaveCopyAs



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Is there a way to alter my beforesave event so that I just save a copy of the workbook I was working in and I am able to select the location on my machine and file name, but I want to retain the .xlsm extension and I want my original workbook to remain open. Right now I have a code that changes the extension to .xlsx and that is no longer a requirement. Leaving it as a .xlsm is just fine. Here is my code:

    Code:
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim newwb As Variant
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Cancel = True
    ActiveSheet.Unprotect
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
         
    Set wb1 = ActiveWorkbook
      
         
         'Set a filename for new workbook
        newwb = Application.GetSaveAsFilename(ActiveWorkbook.FullName, "Excel Files (*.xls), *.xls", , "Set Filename")
        If newwb <> False Then wb1.SaveCopyAs (newwb)
    Call ClearHighlight
    Call ClearMerged
    Call ClearColor
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    ActiveSheet.Protect
    End Sub

  2. #2
    Acolyte Sixthsense's Avatar
    Join Date
    Nov 2012
    Location
    India
    Posts
    26
    Articles
    0
    Try something like this...

    Code:
    Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim newwb As String
    
    ActiveSheet.Unprotect
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.EnableEvents = False
    
        newwb = ThisWorkbook.Path & "\"
    
        Sheets.Copy
    
        With ActiveWorkbook
            .SaveAs newwb & "MyFile" & Format(Now, "DDMMYY HHMMSS"), xlExcel8
            .Close
        End With
    
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.EnableEvents = True
    ActiveSheet.Protect
    
    Cancel = True
    
    End Sub
    Last edited by Sixthsense; 2014-02-26 at 09:21 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •