Excel vba code is leave behind a blank application window

bradyboyy88

Well-known Member
Joined
Feb 25, 2015
Messages
562
I have been trying to perfect some vba code to imitate a web page display. The text is currently centered and I am trying to keep it in its own instance. Everything works except when I open the same document twice it asked if I want to update and lose all my work. Well It would be great if the users select no but if they dont then for some reason this generates a new instance which is good, but leaves behind a blank window. The thing is if I click the X on the blank window it closes both files so they must be in the same instance still. I have been wrapping my head around what is causing this scenario to happen but I cannot figure it out and I know people will try to open the same file more than once. I would be satisfied if the user could open multiple instances of this same file (which I would like to be read only anyway) or not let them do it at all but not leave behind a blank window.

Some testing has shown if I do not change the GUI aspects at all then the code works great but I really need it to update to finish the look of the application!

My code is as follows if you want to paste as an excel class :

Code:
Option Explicit
'Variable Declarations


'Centering Window Event
Public WithEvents appeventCentering As Application


'Creating seperate instances using events
Public WithEvents App As Application


'Centering Content Variables
Public NewWindowWidth As Double
Public OldWindowWidth As Double
Public InitialPaddingWidth As Double
Public InitialWindowWidth As Double
Public InitialCenteringIndex As Double




'-------------------------Auto Centering Content like Container in CSS/HTML---------------------------------
Private Sub appeventCentering_WindowResize(ByVal Wb As Workbook, ByVal Wn As Window)


Dim SheetNumber As Integer


If ThisWorkbook.Application.ActiveWindow.Width > 120 Then
    NewWindowWidth = ThisWorkbook.Windows(1).Width
    If NewWindowWidth < InitialWindowWidth Then
        ThisWorkbook.Windows(1).Width = InitialWindowWidth
    End If


For SheetNumber = 1 To ThisWorkbook.Worksheets.Count


    With ThisWorkbook.Sheets(SheetNumber).Columns("A")
        .ColumnWidth = ThisWorkbook.Application.Min(ThisWorkbook.Application.Max( _
            .ColumnWidth + (NewWindowWidth - OldWindowWidth) / InitialCenteringIndex, _
                                                                    InitialPaddingWidth), 255)
    End With
    
Next


    OldWindowWidth = NewWindowWidth
    
End If


End Sub


Public Sub InitialWidth(WindowWidth As Double, PaddingWidth As Double, CenteringIndex As Double)
    
Dim SheetNumber As Integer


InitialPaddingWidth = PaddingWidth
InitialWindowWidth = WindowWidth
InitialCenteringIndex = CenteringIndex
OldWindowWidth = WindowWidth


Application.WindowState = xlNormal
ThisWorkbook.Application.ActiveWindow.Width = WindowWidth


For SheetNumber = 1 To ThisWorkbook.Worksheets.Count


ThisWorkbook.Worksheets(SheetNumber).Columns("A").ColumnWidth = InitialPaddingWidth
    
Next
    
End Sub
'--------------------------------Seperate Excel Workbook Instances----------------------------------------
'create seperate instances if other workbooks are already open
Public Sub SeperateInstances()


Dim xlApp As New Application


If Application.Workbooks.Count > 1 Then


    If Application.Workbooks.Count > 1 Then
        ThisWorkbook.ChangeFileAccess xlReadOnly
        xlApp.Workbooks.Open ThisWorkbook.FullName
        ThisWorkbook.Close False
    End If


End If


End Sub


'Create a seperate instances for any excel files trying to open while this is open
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    
    Dim xlApp As Application
    
    If Wb Is ThisWorkbook Then Exit Sub
    
    Wb.ChangeFileAccess xlReadOnly
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Workbooks.Open Wb.FullName
    xlApp.Visible = True
    Wb.Close False


End Sub


Private Sub App_NewWorkbook(ByVal Wb As Workbook)
    
    Dim xlApp As Application
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Workbooks.Add
    xlApp.Visible = True
    Wb.Close False
    
End Sub
'--------------------------------Remove & Add Excel GUI Options-------------------------------------
Public Sub GuiUpgrade()
    
    'Excel UI Removal
    Application.ScreenUpdating = False
    Application.Cursor = xlNorthwestArrow
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
    Application.DisplayFormulaBar = False
    Application.DisplayStatusBar = False
    ThisWorkbook.Application.ActiveWindow.DisplayWorkbookTabs = False
    ThisWorkbook.Application.ActiveWindow.DisplayHorizontalScrollBar = False
    ThisWorkbook.Application.ActiveWindow.DisplayGridlines = False
    ThisWorkbook.Application.ActiveWindow.DisplayHeadings = False
    Application.ScreenUpdating = True


    
    'Update Caption on Window Frame
    ThisWorkbook.Application.ActiveWindow.Caption = ""
    Application.Caption = "MMC Rate Review Tool v1.0"
    
End Sub


Public Sub GuiBackToNormal()
    Dim SheetNumber As Integer
    
    'Excel UI Removal
    Application.ScreenUpdating = False
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    Application.DisplayFormulaBar = True
    Application.DisplayStatusBar = True
    ThisWorkbook.Windows(1).DisplayWorkbookTabs = True
    ThisWorkbook.Windows(1).DisplayHorizontalScrollBar = True
    ThisWorkbook.Windows(1).DisplayGridlines = True
    ThisWorkbook.Windows(1).DisplayHeadings = True
    Application.ScreenUpdating = True


    
    'Update Caption on Window Frame
    ThisWorkbook.Application.ActiveWindow.Caption = ""
    Application.Caption = "Beta Tool"
    
    
End Sub
'---------------Maintain Seperate Identity by Deleting itself from Recently Used---------------------------------
Public Sub DeleteRecentlyOpened()


If Application.RecentFiles.Count > 1 Then
    Application.RecentFiles(1).Delete
End If


End Sub


'-----------------------Scroll all Pages/Sheets to same position----------------------------
Public Sub ScrollPage()




End Sub

And in thisworkbook paste:
Code:
Option Explicit
'Seperate instance variables
Dim ExcelGUIUpdates As New ExcelGUIClass


Public Sub Workbook_Open()


ThisWorkbook.Application.Windows(1).Visible = True
Application.Visible = True
Application.DisplayAlerts = False


'Seperate Instance Declaration
Call ExcelGUIUpdates.SeperateInstances
Set ExcelGUIUpdates.App = Application


'Keep window centered similar to css/html container class
Call ExcelGUIUpdates.InitialWidth(720, 12, 13)
Set ExcelGUIUpdates.appeventCentering = Application


Application.WindowState = xlMinimized


'Delete itself from history
Call ExcelGUIUpdates.DeleteRecentlyOpened


'Update the Gui
Call ExcelGUIUpdates.GuiUpgrade


Application.WindowState = xlNormal


'Icon Update
'Call IconUpdate(Directory)


End Sub




Sub ProtectSheets()
Dim SheetNumber As Integer


For SheetNumber = 1 To ThisWorkbook.Worksheets.Count


ThisWorkbook.Sheets(SheetNumber).Protect AllowFormattingColumns:=True
    
Next


End Sub


Sub UnprotectSheets()
Dim SheetNumber As Integer


For SheetNumber = 1 To ThisWorkbook.Worksheets.Count


ThisWorkbook.Sheets(SheetNumber).Unprotect
    
Next


End Sub


Sub BacktoNormal()


Call ExcelGUIUpdates.GuiBackToNormal


End Sub
 
Last edited:

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Any ideas? I just cant figure this out!!

I do know that if I comment out my window operations:

'Update the Gui
Call ExcelGUIUpdates.GuiUpgrade

Then the problem doesnt happen. So not sure why the window and application operations could be causing this.
 
Last edited:
Upvote 0
Has something to do with the ribbon being disabled because if I uncheck that then I am good to go. But I need that disabled!
 
Upvote 0

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top