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 :
And in thisworkbook paste:
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: