Geek Answers Handbook

Excel VBA - always show worksheet open

How can the following conditions be met with VBA code?

  • A separate worksheet is always displayed open, even if the journal is open without including macros.
  • A workbook user can save a workbook on any work sheet during work.
  • Saving should not interfere with the user - do not switch to another sheet, without messages, etc.
  • Regular save functions ( Ctrl- Sby clicking "Save") must remain available, and when used, they must meet the above criteria.

I would like to avoid trying the solutions that I have listed at the bottom of this question.

Details:
A workbook is created using Office 2007 on a computer running Windows 7. This is a .xlsm workbook with two sheets, Scheduler and Information. Sheet tabs are not displayed. Not all users will include macros when opening a book.

When opening the book, the user will be open on only one sheet as follows:

  • "Information" appears if macros are disabled, and basically tells everyone who opens the book that macros must be enabled for the full functionality of the workbook. If macros are included at this moment, the "Scheduler" is activated.
  • A "scheduler" is where data is stored and edited, and automatically displayed if macros are enabled. It is not provided to the user when the workbook is opened without using macros.

"" , , .

( !):

  • Workbook.BeforeSave. "", , . , "" , "" .
  • Application.OnKey Ctrl - S Ctrl - S. , , ( File... Save Office Button... Save).
  • "" . , - Workbook.SheetActivate .SheetChange "" "". VBA .
  • Worksheet("Info").Activate, "" . "" , "", , , .
+4
5

, , Application.OnTime BeforeSave. - :

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

1:

Public PreviousSheet As Worksheet

Public Sub ActivatePreviousSheet()
    If Not PreviousSheet Is Nothing Then
        PreviousSheet.Activate
        Set PreviousSheet = Nothing
    End If
End Sub
+4

? 

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
+5

2: , AfterSave. , , GetSaveAsFilename, .

.

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

Info - , . .

, BeforeSave, . AfterSave. :

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

actSheet "ActiveSheet" .

: , . , , .

, , , . , , !

+1

, , . , , . , , . - , . , . , , , , Reafidy, 400 . , , .

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

.

+1

"-".

"-"

  • - , .
  • VBA, " ", Workbooks.Open( Workbooks. , , AddToMru true)
  • , VBA , ( )

" "

  • , VBA " "
  • , .

I do not have Office 2007 at hand to test this, but I think he should do it.

+1
source

More articles:


All Articles