作成したカレンダーを、良い感じの位置とズームで表示する ②

昨日は、作成したカレンダーがパチッと画面内に収まるようにならないか、色々と試行錯誤してみた。
infoment.hatenablog.com
今日は、昨日のお試し版を更に作りこむことに挑戦する。

昨日のブログ公開の後も、更に試行錯誤を繰り返した。ああでもない、こうでもない。

その時ふと、あるものに気が付いた。

何だこれは。今まで目に入っていたはずなのに、意識したことが無かった。

試しにマクロの記録で、どのような記述になるか確認してみた。

    Range("B2:G10").Select
    ActiveWindow.Zoom = True

え、これだけ？衝撃の事実に、血反吐を吐いて倒れそうになった。

しかしこれならば、話は随分と簡単になる。
１． まず、対象となる範囲を設定する。
２． フィットさせたい範囲によって、選択範囲を変更する。
　 ① 横幅でフィットさせたい ⇒ 一行目を選択する。
　 ② 縦高でフィットさせたい ⇒ 一列目を選択する。
　 ③ 全体をフィットさせたい ⇒ 全体を選択する。
① ～ ③ は、列挙型にして選択することにしよう。

Enum ZoomType
    RowFit
    CollumnFit
    AllFit
End Enum

Sub ZoomFit(target_range As Range, _
            Optional zoom_type As ZoomType = CollumnFit, _
            Optional zoom_ratio As Double = 1)
            
    
    ' フィットさせたい範囲の左上セル。
    Dim UpperLeftCell As Range
    Set UpperLeftCell = GetUpperLeftCell(target_range)
    
    'Gotoメソッドで、当該セルを画面の左上に表示させる。
    Application.Goto UpperLeftCell, True

    ' フィットさせたい範囲の右下セル。
    ' ※余白用にオフセットさせている。
    Dim BottomRightCell As Range
    Set BottomRightCell = target_range.SpecialCells(xlCellTypeLastCell).Offset(1, 1)

    Dim myRng As Range
    Set myRng = Range(UpperLeftCell, BottomRightCell)
        Select Case zoom_type
            Case ZoomType.AllFit
                myRng.Select
            Case ZoomType.CollumnFit
                myRng.Rows(1).Select
            Case ZoomType.RowFit
                myRng.Columns(1).Select
        End Select
        
        ActiveWindow.Zoom = True
        UpperLeftCell.Select
        ActiveWindow.Zoom = ActiveWindow.Zoom * zoom_ratio
End Sub

何だか随分、あっさり短くなってしまった。
早速テストしてみよう。

Sub test()
    With Range("H20")
        .NumberFormatLocal = "d"
        .Value = "4/1"
    End With
    Call MakeCalendar(Range("H20"), 12, 3)
    
    ActiveSheet.UsedRange.EntireColumn.AutoFit
    
    ZoomFit ActiveSheet.UsedRange, RowFit, 1
End Sub

あの苦労は、何だったのか。
それにしても、カレンダーだけでなく、色々な場面で使えそうです。

参考まで。