Best way to activate an unsaved workbook-CodePudding

I have various code to create reports. The reports are added to a new workbook that does not get saved, the theory being that the user can choose whether to save the workbook or just close it after looking at the results. My code below will activate the unsaved workbook.

Sub ActivateWorkbook(wbResults As Workbook)
    Dim objWindow As Window
    
    With Application

        .VBE.MainWindow.WindowState = vbext_ws_Minimize
                
        For Each objWindow In .Windows
            
            With objWindow
                
                If .Caption <> wbResults.Name Then .WindowState = xlMinimized
                
            End With
            
        Next objWindow
        
        With .Windows(wbResults.Name)
            
            .WindowState = xlMaximized
            
            .Activate
            
        End With
                
    End With
    
End Sub

This works okay with a single monitor. But if there is already more than one workbook and they are different monitors, it minimises windows in both (all) monitors and looks less than ideal. I am thinking that if I am able to identify which monitor has the active workbook, I could only minimize windows for that monitor (including the VBE, if required).

In reply to chris neilsen, I will include some basic code to illustrate what I'm calling the above procedure with. Please keep in mind that each procedure is varied in purpose and most of the code in each doesn't really pertain to this particular problem.

Sub ExampleCode()
    Dim wbXXX As Workbook
    
    Set wbXXX = Workbooks.Add
    
    With wbXXX
    
        'Main code here
    
    End With
    
    Call ActivateWorkbook(wbXXX)
    
    Set wbXXX = Nothing
    
End Sub

Thanks to anybody trying to help. It is appreciated.

CodePudding user response：

this should be sufficient - no second sub for activation needed. These should show the new workbook in the foreground, no other windows changed.

Sub ExampleCode()
    Dim wbXXX As Workbook
    
    Set wbXXX = Workbooks.Add
    
    With wbXXX
    
        'Main code here
    
    End With
    
    wbXXX.Activate
    
    Set wbXXX = Nothing
    
End Sub

CodePudding user response：

Okay, this seems to be working for me. It's not pretty. Note that "Microsoft Visual Basic for Applications Extensibility 5.3" is required to minimise the VBE, which is where the code is being run from, not the main Excel application. In any case, Activate has not worked for me reliably in the past. If it works for you, no need for any of this I guess. If anybody is game to test it, please let me know how you go. I have only tested on a dual monitor setup so far.

Objective: Show the new workbook in the same monitor as the active workbook when Activate does not work.

Private Declare PtrSafe Function FindWindow _
    Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) _
    As LongPtr
    
Private Declare PtrSafe Function MonitorFromWindow _
    Lib "user32" _
    (ByVal hwnd As LongPtr, _
    ByVal dwFlags As Long) _
    As LongPtr
    
Private Declare PtrSafe Function EnumDisplayMonitors _
    Lib "user32.dll" _
    (ByVal hdc As Long, _
    ByRef lprcClip As Any, _
    ByVal lpfnEnum As Long, _
    ByVal dwData As Long) _
    As Long
    
Private Declare PtrSafe Function GetSystemMetrics _
    Lib "user32" _
    (ByVal Index As Long) _
    As Long
    
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const MONITOR_DEFAULTTONEAREST = &H2
Private Const SM_CMONITORS As Long = 80

Private hWndMonitor As LongPtr
Private hActiveWorkbook As LongPtr
Private hVBE As LongPtr
Private lngMode As Long

Function MonitorCount() As Long
    
    MonitorCount = GetSystemMetrics(SM_CMONITORS)
    
End Function

Function MonitorsAreTheSame() As Boolean
    
    MonitorsAreTheSame = True
    
    'Count of monitors
    If MonitorCount > 1 Then
        
        'Check the ActiveWorkbook
        lngMode = 0
        
        hWndMonitor = FindWindow("XLMAIN", Application.Caption)
        
        EnumDisplayMonitors ByVal 0&, ByVal 0&, AddressOf MonitorEnumProc, ByVal 0&
        
        'Check the VBE
        lngMode = 1
        
        hWndMonitor = FindWindow("wndclass_desked_gsk", Application.VBE.MainWindow.Caption)
        
        EnumDisplayMonitors ByVal 0&, ByVal 0&, AddressOf MonitorEnumProc, ByVal 0&
        
        MonitorsAreTheSame = CBool(hActiveWorkbook = hVBE)
        
    End If
    
End Function

Private Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, lprcMonitor As RECT, ByVal dwData As Long) As Long
    
    If MonitorFromWindow(hWndMonitor, MONITOR_DEFAULTTONEAREST) = hMonitor Then
        
        Select Case lngMode
            
            Case 0
                
                hActiveWorkbook = CStr(hMonitor)
                
            Case 1
                
                hVBE = CStr(hMonitor)
                
        End Select
        
    End If
    
    MonitorEnumProc = MonitorCount
    
End Function

Sub Test()
    Dim wbkTest As Workbook
    
    Set wbkTest = Workbooks.Add
    
    Call ActivateWorkbook(wbkTest)
    
    Set wbkTest = Nothing
    
End Sub

Sub ActivateWorkbook(wbkResults As Workbook)
    Dim objWindow As Window
    
    With Application
    
         If MonitorsAreTheSame = True Then
        
            .VBE.MainWindow.WindowState = vbext_ws_Minimize
            
            For Each objWindow In .Windows
                
                With objWindow
                
                    If .Left = Application.VBE.MainWindow.Left Then
                    
                        If .Caption <> wbkResults.Name Then .WindowState = xlMinimized
                        
                    End If
                    
                End With
                
            Next objWindow
            
        Else
            
            For Each objWindow In .Windows
                
                With objWindow
                
                    If .Left <> Application.VBE.MainWindow.Left Then
                    
                        If .Caption <> wbkResults.Name Then .WindowState = xlMinimized
                        
                    End If
                    
                End With
                
            Next objWindow
            
        End If
                        
        .Windows(wbkResults.Name).WindowState = xlMaximized
        
        AppActivate (.Caption)
                
    End With
    
End Sub