This is barely tested but have a go. Strongly suggest only deploy it if you
can follow it and know how to correct anything that's not right!
Run NoCaptions() to give the activeworkbook three captionless windows
Run ResetAllCaptions() to reset Captions to all windows
Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
( _
ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
( _
ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long _
) As Long
Private Declare Function DrawMenuBar Lib "user32" ( _
ByVal hWnd As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Public Declare Function GetWindow Lib "user32" ( _
ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Const GWL_STYLE As Long = (-16)
Private Const WS_CAPTION As Long = &HC00000
Public Const GW_HWNDNEXT = 2
Sub ResetAllCaptions()
appSettings False
WorkbookCaptions True, 123456
FlashWindows
appSettings True
End Sub
Sub NoCaptions()
Dim i As Long
Dim numWindows As Long
Dim oldState As Long
Dim wb As Workbook, wbCaptions As Workbook
Dim wn As Window, wnA As Window
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wbCaptions = ActiveWorkbook
numWindows = 3
For Each wb In Workbooks
Set wnA = ActiveWindow
For Each wn In wb.Windows
If wn.Visible Then
wn.WindowState = xlMinimized
End If
Next
wnA.Activate
Next
For Each wn In wbCaptions.Windows
wn.WindowState = xlNormal
Next
Do While ActiveWorkbook.Windows.Count < numWindows
ActiveWindow.NewWindow
ActiveWindow.WindowState = xlNormal
Loop
Windows.Arrange ArrangeStyle:=xlVertical
WorkbookCaptions False, numWindows
FlashWindows
Application.ScreenUpdating = True
End Sub
Sub appSettings(bEnable As Boolean)
With Application
.EnableEvents = bEnable
.ScreenUpdating = bEnable
End With
End Sub
Sub FlashWindows()
Dim oldState As Long, i As Long
Dim nWB As Long, nWin As Long
Dim wnA As Window, wn As Window
ReDim arrwins(1 To Application.Windows.Count)
ReDim arrState(1 To UBound(arrwins)) As Long
For Each wn In Application.Windows
i = i + 1
Set arrwins(i) = wn
arrState(i) = wn.WindowState
Next
For i = UBound(arrwins) To 1 Step -1
With arrwins(i)
If .Visible And arrState(i) <> xlMinimized Then
.WindowState = xlMinimized
.WindowState = arrState(i)
End If
End With
Next
End Sub
Sub WorkbookCaptions(ByVal bHasCaption As Boolean, winCnt As Long)
Dim hDesk As Long, hExcel7 As Long, cnt As Long
Dim sBuff As String * 16
Const cDESK As String = "XLDESK", cXL7 As String = "EXCEL7"
hDesk = FindWindowEx(Application.hWnd, 0, cDESK, vbNullString)
hExcel7 = FindWindowEx(hDesk, 0, cXL7, vbNullString)
cnt = 1
Do While hExcel7
Call GetClassName(hExcel7, sBuff, 16)
If UCase$(Left$(sBuff, Len(cXL7))) = cXL7 Then
If cnt > winCnt Then bHasCaption = True
SetCap hExcel7, bHasCaption
End If
hExcel7 = GetWindow(hExcel7, GW_HWNDNEXT)
cnt = cnt + 1
Loop
End Sub
Function SetCap(hWnd As Long, bCaption As Boolean) As Long
Dim OldStyle As Long, NewStyle As Long
OldStyle = GetWindowLong(hWnd, GWL_STYLE)
If bCaption Then
NewStyle = OldStyle Or WS_CAPTION
Else
NewStyle = OldStyle And Not WS_CAPTION
End If
If NewStyle <> OldStyle Then
SetWindowLong hWnd, GWL_STYLE, NewStyle
DrawMenuBar hWnd
End If
End Function
Note, some things appear to work slightly differently in 2003 & 2007
Regards,
Peter T
