Currently I have a code that allows me to produce the current date when I run the code. However, I would like date automatically to be updated when it is closed so then when I open it the next time, I would know when was the date last opened. Below is the code that I have currently:
Private Sub Worksheet_Activate()
Dim Home As Worksheet
Set Home = Worksheets("Program Status Summary")
Home.Range("A1").Value = Format(Now(), "dd/mmm/yyyy")
End Sub
To follow up on my comment: Simply add an event handler for Workbook_BeforeClose to the workbook object of the VBA project.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Home As Worksheet
Set Home = Worksheets("Program Status Summary")
Home.Range("A1").Value = Format(Now(), "dd/mmm/yyyy")
End Sub
You'll probably want to save the changes as well in order to prevent a "save changes" prompt.
Update: The following example automatically saves changes if the workbook was saved before the code made changes. This is necessary to avoid saving changes that the user didn't intend.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wasSaved As Boolean
wasSaved = ThisWorkbook.saved
Dim Home As Worksheet
Set Home = Worksheets("Program Status Summary")
Home.Range("A1").Value = Format(Now(), "dd/mmm/yyyy")
If wasSaved Then ThisWorkbook.Save
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Range("A1") = Date
ThisWorkbook.Save
End Sub
This would do it.
The "ThisWorkbook.save" part saves the workbook after adding with the current date
Related
Hello One of the VP where I work made a workbook that has the below macro in it. For some reason after I open the file and close it on my own the file re-opens itself every so often. Is this because the timer in the workbook is set to reset its closing process? I am not very well versed in VBA yet so that may not be even close to what the Sub Reset is doing. Note this apparently only happens to me and not anyone else and we have no idea why. only VBA experience I have is like making workbooks that don't close as pranks or making time stamps or color counting formulas.
Dim xTime As String
Dim xWB As Workbook
Private Sub Workbook_Open()
'Updated by Extendoffice 2019/1/20
On Error Resume Next
xTime = "00:30:00"
Set xWB = ActiveWorkbook
If xTime = "" Then Exit Sub
Reset
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error Resume Next
If xTime = "00:30:00" Then Exit Sub
Reset
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If xTime = "" Then Exit Sub
Reset
End Sub
Sub Reset()
Static xCloseTime
If xCloseTime <> 0 Then
ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , False
End If
xCloseTime = Now + TimeValue(xTime)
ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , True
End Sub
The timer is a async process so it will keep running in background
you can reset it on closing of the workbook.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Reset
End Sub
The workbook is being reopened when Application.OnTime calls the SaveWork1 that is attached to it. Static xCloseTime is storing the time that the SaveWork1 is scheduled to be ran. The time is being stored so that the Application.OnTime event can be cancelled.
I believe that you are the only one being affected because you are the only one that dabbles in VBA. VBA errors may cause Static variables to lose their values. When Static xCloseTime the SaveWork1 is rescheduled.
I will always have Workbook SQ_Macro_v1 as my main DB.
Two named Workbooks old_wk and new_wk will have different names, as I will choose them among the currently active WB on my computer.
I am going for a VBA ComboBox listing it all to a choice of mine, but in the end I am not able to store the name of my chosen WB.
Sub Macro1()
Dim main_wk, old_wk, new_wk As Workbook
Set main_wk = Workbooks("SQ_Macro_v1.xlsm")
Set old_wk = Workbooks(old_chosen) 'also tried UserForm1.ComboBox1.Value
Set new_wk = Workbooks(FileName_New) '
main_wk.Sheets("Main_DB").Range("C4").Value = old_wk.Worksheets("Sheet 1 Synthese").Range("C35").Value
As I run the UserForm code below, the old_chosen variable I set as empty in the main Sub. It seems that as I close the UserForm after it runs, nothing remains stored. Any clues to keep that variable saved after I close the UserForm?
Option Explicit
Public Sub UserForm_Activate()
Dim vWorkbook As Workbook
ComboBox1.Clear
For Each vWorkbook In Workbooks
ComboBox1.AddItem vWorkbook.Name
Next
End Sub
Public Sub CommandButton1_Click()
If ComboBox1.ListIndex <> -1 Then
Call YourMacro(ComboBox1)
End If
End Sub
Public Sub YourMacro(vWorkbookName As String)
Dim old_chosen As String
old_chosen = Me.ComboBox1.Value
MsgBox "You choose: " & Workbooks(vWorkbookName).Name
End Sub
The MsgBox pops up but no value is stored afterward:
Public Sub YourMacro(vWorkbookName As String)
Dim old_chosen As String
old_chosen = Me.ComboBox1.Value
MsgBox "You choose: " & Workbooks(vWorkbookName).Name
End Sub
You have declared the variable at procedure level and hence it is not visible after the userform is closed.
To make this variable available to all procedures in the project, precede it with the Public statement. Insert a module and paste this there
Public old_chosen As String
Having said that, I would recommend moving Macro1 inside the userform and handle the code from there after declaring the variable at module level
I am trying to change active printer according to worksheet name when click on Quick Print button, however, the App_WorkbookBeforePrint event is triggered twice. Tried App_WorkbookBeforeClose also triggered twice. I have already changed the Error Trapping to Break on All Error, but it seems like no errors have occurred.
ThisWorkbook:
Private XLApp As CExcelEvents
Private Sub Workbook_Open()
Set XLApp = New CExcelEvents
End Sub
Class Modules:
Option Explicit
Private WithEvents App As Application
Private Sub Class_Initialize()
Set App = Application
End Sub
Private Sub App_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)
MsgBox Wb.FullName
assignPrinter
End Sub
Module:
Const printer1 As String = "Bullzip PDF Printer on Ne10:"
Const printer2 As String = "EPSONF7E8B5 (L565 Series) on Ne07:"
Public Sub assignPrinter()
Dim ws As Worksheet
Dim wsn As String
Set ws = ActiveWorkbook.ActiveSheet
wsn = ws.Name
Select Case wsn
Case "FGWIP"
Application.ActivePrinter = printer1
ws.PrintOut
Exit Sub
Case "Rework"
Application.ActivePrinter = printer2
ws.PrintOut
Exit Sub
Case Else
MsgBox "Else case."
Exit Sub
End Select
End Sub
Update:
Use App_SheetActivate instead of App_WorkbookBeforePrint to change active printer and remove ws.Printout as mentioned by Matley
I re-created your modules and the only error I received was in the code Debug.Print assignPrinter in which I replaced with assignPrinter.
The rest of the codes works fine. App_WorkbookBeforePrint did not trigger twice. You can set a breakpoint in App_WorkbookBeforePrint then look into Stack to see which triggers App_WorkbookBeforePrint for the second time.
I'am trying to prevent users from pasting other things than values in the template I'm developing. I use a macro to always paste values in the worksheet (see below). When users switch to another workbook this macro should be disabled.
The problem is that I get error 91 when activating another workbook.
'the macro in a module
Sub AlwaysPasteValues()
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
'the code in this workbook
Public wb As Workbook
Private Sub Workbook_Activate()
Application.MacroOptions Macro:="AlwaysPasteValues", Description:="AlwaysPasteValues", ShortcutKey:="v"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set wb = Nothing
End Sub
Private Sub Workbook_Deactivate()
With wb
.MacroOptions Macro:="AlwaysPasteValues", Description:="AlwaysPasteValues", ShortcutKey:=""
End With
End Sub
Private Sub Workbook_Open()
Set wb = ThisWorkbook
End Sub
You are changing .MacroOptions on wb which does not exist as a property. MacroOptions is for the Application. Use the same code as the Activate and you should be good.
Private Sub Workbook_Deactivate()
Application.MacroOptions Macro:="AlwaysPasteValues", Description:="AlwaysPasteValues", ShortcutKey:=""
End Sub
How can the following conditions be met with VBA code?
A particular worksheet is always displayed on open, even if the worbook is opened without enabling macros.
A workbook user may save the workbook while working on any worksheet.
The save must not interfere with the user - no navigating away to a different sheet, no messageboxes, etc.
The regular save functions (Ctrl-S, clicking Save) must remain available and when used must obey the criteria above.
I'd like to avoid the attempted solutions I've listed at the bottom of this question.
Details:
The workbook is created using Office 2007 on a Windows 7 machine. It is an .xlsm workbook with 2 worksheets, "Scheduler" and "Info." Sheet tabs are not visible. Not all users will enabled macros when the workbook is opened.
Upon opening the workbook, a user will only be exposed to one sheet as follows:
"Info" shows up if macros are disabled, and basically tells anyone who opens the workbook that macros need to be enabled for full workbook functionality. If macros are enabled at this point, "Scheduler" is activated.
"Scheduler" is where data is stored and edited, and is automatically shown if macros are enabled. It is not presented to the user when the workbook is opened without macros enabled.
"Info" must show up first thing if the workbook is opened and macros are disabled.
Attempted Solutions (I'm looking for better solutions!):
Placing code in the Workbook.BeforeSave event. This saves with "Info" activated so it shows up when the workbook is opened. However, if the user is in "Scheduler" and not done, I cannot find a way in this event to re-activate "Scheduler" after the save.
Using Application.OnKey to remap the Ctrl-s and Ctrl-S keystrokes. Unfortunately this leaves out the user who saves using the mouse (clicking File...Save or Office Button...Save).
Checking during every action and if needed activating "Scheduler". In other words, inserting code in something like the Workbook.SheetActivate or .SheetChange events to put "Scheduler" back into focus after a save with "Info" activated. This runs VBA code constantly and strikes me as a good way to get the other code in the workbook into trouble.
Placing code in the Worksheet("Info").Activate event, to change focus back to "Scheduler". This leads to the result of "Scheduler", not "Info", showing when the workbook is opened, even with macros disabled.
Will this not work? Updated to handle Saving gracefully
Private Sub Workbook_Open()
ThisWorkbook.Worksheets("Scheduler").Activate
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Worksheets("Info").Activate
If (ShouldSaveBeforeClose()) Then
Me.Save
Else
Me.Saved = True ' Prevents Excel Save prompt.
End If
End Sub
Private Function ShouldSaveBeforeClose() As Boolean
Dim workbookDirty As Boolean
workbookDirty = (Not Me.Saved)
If (Not workbookDirty) Then
ShouldSaveBeforeClose= False
Exit Function
End If
Dim response As Integer
response = MsgBox("Save changes to WorkBook?", vbYesNo, "Attention")
ShouldSaveBeforeClose= (response = VbMsgBoxResult.vbYes)
End Function
I don't have time to test this out, but you might be able to do this using Application.OnTime in your BeforeSave event handler. Something like:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim objActiveSheet
Set objActiveSheet = Me.ActiveSheet
If objActiveSheet Is InfoSheet Then Exit Sub
If Module1.PreviousSheet Is Nothing Then
Set Module1.PreviousSheet = objActiveSheet
InfoSheet.Activate
Application.OnTime Now, "ActivatePreviousSheet"
End If
End Sub
Then in Module1:
Public PreviousSheet As Worksheet
Public Sub ActivatePreviousSheet()
If Not PreviousSheet Is Nothing Then
PreviousSheet.Activate
Set PreviousSheet = Nothing
End If
End Sub
Edit 2: Here is a re-write that does not utilize AfterSave. You may need to tweak the dialog created from GetSaveAsFilename according to your needs.
This relies on overriding default save behavior and handling the save yourself.
Private actSheet As Worksheet
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
PrepareForSave
manualSave SaveAsUI
AfterSave ThisWorkbook.Saved
End Sub
Private Sub PrepareForSave()
Set actSheet = ThisWorkbook.ActiveSheet
ThisWorkbook.Sheets("Info").Activate
hidesheets
End Sub
Private Sub manualSave(ByVal SaveAsUI As Boolean)
On Error GoTo SaveError 'To catch failed save as
Application.EnableEvents = False
If SaveAsUI Then
If Val(Application.Version) >= 12 Then
sPathname = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsm), *.xlsm")
If sPathname = False Then 'User hit Cancel
GoTo CleanUp
End If
ThisWorkbook.SaveAs Filename:=sPathname, FileFormat:=52
Else
sPathname = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xls), *.xls")
If sPathname = False Then
GoTo CleanUp
End If
ThisWorkbook.SaveAs Filename:=sPathname, FileFormat:=xlNormal
End If
Else
ThisWorkbook.Save
End If
SaveError:
If Err.Number = 1004 Then
'Cannot access save location
'User clicked no to overwrite
'Or hit cancel
End If
CleanUp:
Application.EnableEvents = True
End Sub
Private Sub AfterSave(ByVal bSaved As Boolean)
showsheets
If actSheet Is Nothing Then
ThisWorkbook.Sheets("Scheduler").Activate
Else
actSheet.Activate
Set actSheet = Nothing
End If
If bSaved Then
ThisWorkbook.Saved = True
End If
End Sub
Private Sub hidesheets()
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Info" Then
ws.Visible = xlVeryHidden
End If
Next
End Sub
Private Sub showsheets()
For Each ws In ThisWorkbook.Worksheets
ws.Visible = True
Next
End Sub
Private Sub Workbook_Open()
AfterSave True
End Sub
The only way to make Info display first without macros enabled is if that is how the workbook was saved. This is most reasonably handled when saving.
Unless I misunderstood your issue, not using BeforeSave seems misguided. Just make sure to use AfterSave as well. Here's an example:
Private actSheet As Worksheet
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
showsheets
actSheet.Activate
Set actSheet = Nothing
Thisworkbook.Saved = true 'To prevent save prompt from appearing
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Set actSheet = ThisWorkbook.activeSheet
ThisWorkbook.Sheets("Info").Activate
hidesheets
End Sub
Private Sub Workbook_Open()
showsheets
ThisWorkbook.Sheets("Scheduler").Activate
End Sub
Private Sub hidesheets()
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Info" Then
ws.Visible = xlVeryHidden
End If
Next
End Sub
Private Sub showsheets()
For Each ws In ThisWorkbook.Worksheets
ws.Visible = True
Next
End Sub
The use of the private object actSheet allows the "ActiveSheet" to be reselected after save.
Edit: I noticed you had more requirements in the comments. The code has been updated so that now upon saving, only the Info sheet will be visible, but when opened or after saving, every sheet will reappear.
This makes it so that any user opening the file without macros will not be able to save with a different sheet activated, or even view the other sheets. That would certainly help motivate them to enable macros!
This problem has been flogged to death in the past, its just hard to find a solution that actually works. Take a look at this code which should do what you need. Basically it shows a splash screen, with all other sheets hidden if the user does not enable macros. It will still save normally if the user clicks save and wont interfere with their work. If they save with there worksheet open it will still show only the splash screen when next opened. Download the sample file below and you can test for yourself, make sure you download the file posted by Reafidy it has over 400 views. If you need it modified further let me know.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
bIsClosing = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim wsArray() As Variant
Dim iCnt As Integer
Application.ScreenUpdating = 0
Splash.Visible = True
For Each wsSht In ThisWorkbook.Worksheets
If Not wsSht.CodeName = "Splash" Then
If wsSht.Visible = True Then
iCnt = iCnt + 1: Redim Preserve wsArray(1 To iCnt)
wsArray(iCnt) = wsSht.Name
End If
wsSht.Visible = xlSheetVeryHidden
End If
Next
Application.EnableEvents = 0
ThisWorkbook.Save
Application.EnableEvents = 1
If Not bIsClosing Then
For iCnt = 1 To UBound(wsArray)
Worksheets(wsArray(iCnt)).Visible = True
Next iCnt
Splash.Visible = False
Cancel = True
End If
Application.ScreenUpdating = 1
End Sub
Private Sub Workbook_Open()
Dim wsSht As Worksheet
For Each wsSht In ThisWorkbook.Worksheets
wsSht.Visible = xlSheetVisible
Next wsSht
Splash.Visible = xlSheetVeryHidden
bIsClosing = False
End Sub
A sample file can be found here.
How about using a 'proxy workbook'.
The 'proxy workbook'
is the only workbook which is directly opened by the users
contains the info sheet
contains VBA to open your 'real workbook' using Workbooks.Open (As I've checked with Workbooks.Open documentation by default it will not add the file name to your recent files history unless you set the AddToMru argument to true)
if required the VBA code could even make sure that your 'target workbook' is trusted (I found some sample code here)
The 'target workbook'
contains your Schedule and any other sheets
is only opened if the VBA code in 'proxy workbook' was executed
can be saved by the user at any time as usual
I've got no Office 2007 at hand to test this but think it should do.