Private Sub №8_Подготовка_листа()
    Dim oX&, oY&, Visota&, Shirina As Long
    Dim Ap As Application, rn As Range
    '=========================
    Set Ap = Application
    Visota = Ap.InputBox(prompt:="Высота диапазона")
    Shirina = Ap.InputBox(prompt:="Ширина диапазона")
    '--------------------
    Set rn = Cells(1, 1).Resize(Visota, Shirina)
    Cells(1).Select
    Cells.ColumnWidth = 3
    Cells.RowHeight = 15
    '=========================
    oX = 1
    Do
        If oX < 13 _
        Then Cells.ColumnWidth = oX / 12
        If oX > 12 _
        Then Cells.ColumnWidth = (oX - 12) / 7 + 1
        If ActiveWindow.VisibleRange.Address <> _
           Union(Cells(3, 3), ActiveWindow.VisibleRange).Address _
        Then Exit Do
        oX = oX + 1
        DoEvents
    Loop
    oX = (oX - 1) * 2
    Cells.ColumnWidth = 3
    '--------------------
    oY = 1
    Do
        Cells.RowHeight = oY * 0.75
        If ActiveWindow.VisibleRange.Address <> _
           Union(Cells(3, 3), ActiveWindow.VisibleRange).Address _
        Then Exit Do
        oY = oY + 1
        DoEvents
    Loop
    oY = (oY - 1) * 2
    '====================
    Cells.EntireRow.Hidden = True
    Cells.EntireColumn.Hidden = True
    oX = Ap.Floor(oX / Shirina, 1)
    oY = Ap.Floor(oY / Visota, 1)
    '--------------------
    If oX < 13 Then _
    rn.ColumnWidth = oX / 12
    If oX > 12 Then _
    rn.ColumnWidth = (oX - 12) / 7 + 1
    rn.RowHeight = oY * 0.75
    Cells(1).Select
    '=========================
End Sub

Private Sub №8_Подготовка_листа()
    Dim oX As Long
    Dim Ap As Application
    Dim СтолбБ As Range
    Dim КрайТабы As Range 'Ячейка справа снизу от нижнего правого угла табы _
                           Ячейка дожна быть видна на экране при запуске макроса
    '=========================
    Set Ap = Application
    Set СтолбБ = Cells(1, "B")
    Set КрайТабы = Cells(104, "G")
    '--------------------
    Cells(1).Select
    СтолбБ.ColumnWidth = 3
    '=========================
    oX = 1
    Do
        If oX < 13 _
        Then СтолбБ.ColumnWidth = oX / 12
        If oX > 12 _
        Then СтолбБ.ColumnWidth = (oX - 12) / 7 + 1
        '----------
        If ActiveWindow.VisibleRange.Address <> _
           Union(КрайТабы, ActiveWindow.VisibleRange).Address _
        Then Exit Do
        oX = oX + 1
        DoEvents
    Loop
    oX = oX - 1
    '====================
    If oX < 13 Then _
    СтолбБ.ColumnWidth = oX / 12
    If oX > 12 Then _
    СтолбБ.ColumnWidth = (oX - 12) / 7 + 1
    Cells(1).Select
    '=========================
End Sub

Private Sub №8_Подготовка_листа()
    Dim oX As Long
    Dim Ap As Application
    Dim СтолбБ As Range
    Dim КрайТабы As Range 'Ячейка справа снизу от нижнего правого угла табы
    '=========================
    Set Ap = Application
    Set СтолбБ = Cells(1, "B")
    Set КрайТабы = Cells(1, "G").EntireColumn
    '--------------------
    Cells(1).Select
    СтолбБ.ColumnWidth = 3
    '=========================
    oX = 1
    Do
        If oX < 13 _
        Then СтолбБ.ColumnWidth = oX / 12
        If oX > 12 _
        Then СтолбБ.ColumnWidth = (oX - 12) / 7 + 1
        '----------
        If ActiveWindow.VisibleRange.EntireColumn.Address <> _
           Union(КрайТабы, ActiveWindow.VisibleRange.EntireColumn).Address _
        Then Exit Do
        oX = oX + 1
        DoEvents
    Loop
    oX = oX - 1
    '====================
    If oX < 13 Then _
    СтолбБ.ColumnWidth = oX / 12
    If oX > 12 Then _
    СтолбБ.ColumnWidth = (oX - 12) / 7 + 1
    Cells(1).Select
    '=========================
End Sub

VPageBreaks(1)