Attribute VB_Name = "Window1"
'___________________________________________________________
'sample-vbaxlwi1-1 version 1.1, Copyright (C) 2001 Tomizono <tomizono@yahoo.com>
'sample-vbaxlwi1-1 comes with ABSOLUTELY NO WARRANTY. This is free software,
'and you are welcome to redistribute it under certain conditions.
'See http://www.gnu.org/copyleft/gpl.html#SEC3 for details.
'___________________________________________________________
'discribes howto treat MS Excel Window objects.
'this is a VBA module source for MS Excel.
'this version: http://www.geocities.com/tomizono/gpl/2001/sample-vbaxlwi1-1.1.1.bas
'lattest: http://www.geocities.com/tomizono/gpl/sample-vbaxlwi1-1.bas
'
'Further information is available at:
'http://www.geocities.com/tomizono/vba/workbook1.html
'___________________________________________________________
'sample-vbaxlwi1-1: discribes howto treat MS Excel Window objects.
'Copyright (C) 2001 Tomizono <tomizono@yahoo.com>
'
'This program is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published by
'the Free Software Foundation; either version 2 of the License, or
'(at your option) any later version.
'
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'GNU General Public License for more details.
'
'You should have received a copy of the GNU General Public License
'along with this program; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'___________________________________________________________

Option Explicit

Sub Window1()
' 新規 Window を作成する。
    Dim wi As Window
    Set wi = ActiveWorkbook.NewWindow
    MsgBox wi.Caption, vbOKOnly, wi.WindowNumber
End Sub

Sub Window2()
' 新規 Window を作成する。
    Dim wi As Window
    ActiveWindow.NewWindow
End Sub

Sub Window3()
' 多重に開いた Window を、まとめて閉じて 1つにする。
    Dim wi As Window
    For Each wi In ActiveWindow.Parent.Windows
        If wi.Parent.Windows.Count = 1 Then Exit For
        wi.Close
    Next wi
End Sub

Sub Window3B()
' 多重に開いた Window を、まとめて閉じて 1つにする。
    Dim wb As Workbook
    Set wb = ActiveWindow.Parent
    Do Until wb.Windows.Count = 1
        wb.Windows(2).Close
    Loop
End Sub

Sub Window4()
' すべてのブックについて、多重に開いた Window を、まとめて閉じて 1つにする。
    Dim wb As Workbook
    For Each wb In Workbooks
        Do Until wb.Windows.Count = 1
            wb.Windows(2).Close
        Loop
    Next wb
End Sub

Sub Window5()
' ウィンドウを順次、切り替える。
    Dim wi As Window
    For Each wi In Windows
        wi.Activate
        Application.Wait Now() + 1 / 24 / 3600
    Next wi
End Sub

Sub Window5B()
' ウィンドウを順次、切り替える。
    Dim oldWin As String
    Dim newWin As String
    oldWin = ActiveWindow.Caption
    Do
        ActiveWindow.ActivateNext
        Application.Wait Now() + 1 / 24 / 3600
        newWin = ActiveWindow.Caption
    Loop Until oldWin = newWin
End Sub

Sub Window5C()
' ウィンドウを順次、切り替える。
    Dim oldWin As String
    Dim newWin As String
    oldWin = ActiveWindow.Caption
    Do
        ActiveWindow.ActivatePrevious
        Application.Wait Now() + 1 / 24 / 3600
        newWin = ActiveWindow.Caption
    Loop Until oldWin = newWin
End Sub

Sub Window6()
' Window を整列する。
    Windows.Arrange ArrangeStyle:=xlArrangeStyleTiled
End Sub

Sub Window7()
' Window の整列を解く。
    ActiveWindow.WindowState = xlMaximized
End Sub

Sub Window8()
' 各種表示変更。
    With ActiveWindow
        .DisplayFormulas = Not .DisplayFormulas
        .DisplayGridlines = Not .DisplayGridlines
        .DisplayHeadings = Not .DisplayHeadings
        .DisplayHorizontalScrollBar = Not .DisplayHorizontalScrollBar
        .DisplayOutline = Not .DisplayOutline
        .DisplayVerticalScrollBar = Not .DisplayVerticalScrollBar
        .DisplayWorkbookTabs = Not .DisplayWorkbookTabs
        .DisplayZeros = Not .DisplayZeros
        .EnableResize = Not .EnableResize
    End With
End Sub

Sub Window9()
' Window の表示・非表示を切り替える。
    Static wiCap As String
    If wiCap = "" Then
        wiCap = ActiveWindow.Caption
        Windows(wiCap).Visible = False
    Else
        Windows(wiCap).Visible = True
        wiCap = ""
    End If
End Sub

Sub Window10()
' 表示倍率を変更する。
    With ActiveWindow
        .Zoom = 150 - .Zoom
        MsgBox "現在の倍率" & .Zoom & "%では、" & .VisibleRange.Address & "が見えています。"
    End With
End Sub