XL: Macro to Return Exact Visible Range in Points

Last reviewed: February 3, 1998
Article ID: Q149241

The information in this article applies to:
  • Microsoft Excel 98 Macintosh Edition
  • Microsoft Excel 97 for Windows
  • Microsoft Excel for Windows 95, versions 7.0, 7.0a
  • Microsoft Excel for Windows, versions 5.0, 5.0c
  • Microsoft Excel for Windows NT, version 5.0
  • Microsoft Excel for the Macintosh, versions 5.0, 5.0a

SUMMARY

This article demonstrates how to get the exact visible range of a worksheet, measured in points. This information makes it possible to exactly fill the visible range with a graphic object, such as a chart.

Note that you may not always be able to determine the exact visible range on all computers, because the visible range may vary depending on the video drivers and video settings you are using. However, the macro in this article will return coordinates that are very close to exact.

MORE INFORMATION

Microsoft provides programming examples for illustration only, without warranty either expressed or implied, including, but not limited to, the implied warranties of merchantability and/or fitness for a particular purpose. This article assumes that you are familiar with the programming language being demonstrated and the tools used to create and debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific needs. If you have limited programming experience, you may want to contact the Microsoft fee-based consulting line at (800) 936-5200. For more information about the support options available from Microsoft, please see the following page on the World Wide Web:

   http://www.microsoft.com/support/supportnet/refguide/default.asp

To exactly fill the visible range of a worksheet with a graphic object, such as a chart, you must know the exact Top, Left, Height and Width coordinates in points. The ActiveWindow.VisibleRange property returns the range including the partially visible column to the right and the partially visible row at the bottom. The Top and Left property of that range can be used to get the desired top and left point coordinates, to get the width property of all columns except the rightmost one, and to get the height property of all rows except the bottom one.

Note, however, that there is no direct way of getting the width of the visible portion of the rightmost column or the height of the visible portion of the bottom row. The only way to get that information is to incrementally make the last column and bottom row wider or narrower until the ActiveWindow.VisibleRange property returns one fewer or more columns and rows.

The Width property of columns is read-only. Therefore, you can only widen a column with the ColumnWidth property, which is measured based on the Normal font rather than in points (the Normal may vary from computer to computer). Furthermore, the ColumnWidth property will only widen or narrow a column by a certain minimum incremental amount, otherwise the column does not widen. So, it is first necessary to experiment with a column to find the smallest amount that it can be widened. Then, incrementally widen or narrow it until the VisibleRange property returns one fewer or more columns. Once you have determined this measurement, note the new column width and return the column to its original width.

Row size is easier to determine, since the rowheight property is measured in points; however, rows have a minimum incremental amount by which they can be made shorter, which can vary depending on the type of computer you have.

Sample Macro to Get the Exact Visible Range

   Dim LeftCol, LastCol, TopRow, LastRow, NumCols, _
       NumRows, Cadd, Radd As Integer

   Dim ScreenTop, ScreenLeft, ScreenHeight, ScreenWidth, _
       ADJUST_BOTTOM_UPWARDS, ADJUST_RIGHT_SIDE_LEFTWARD, _
       ADJUST_TOP_DOWNWARDS, ADJUST_LEFT_SIDE_RIGHTWARD, _
       oldW, oldH, OldCw, OldCsw, OldRh, newW, newH, _
       Cinc, Rinc, Builder As Double

   ' Enter custom adjustments here,
   ' if desired.

   Sub CUSTOM_ADJUSTMENTS()
       ADJUST_TOP_DOWNWARDS = 0
       ADJUST_BOTTOM_UPWARDS = 0
       ADJUST_LEFT_SIDE_RIGHTWARD = 0
       ADJUST_RIGHT_SIDE_LEFTWARD = 0
   End Sub

   Sub Get_Visible_Area()
       Application.ScreenUpdating = False
       CUSTOM_ADJUSTMENTS
       Sheets("Sheet1").Select

       ' Find minimum effective ColumnWidth increment.
       ' ============================================

       oldW = Columns(1).ColumnWidth
       Builder = 0.001
       ' Try to widen column by incrementally larger
       ' amounts until it gets Builder:
       Do Until Columns(1).ColumnWidth > oldW
           Columns(1).ColumnWidth = Columns(1).ColumnWidth + Builder
           Builder = Builder + 0.001
       Loop
       newW = Columns(1).ColumnWidth
       ' Return column to its original width:
       Columns(1).ColumnWidth = oldW
       Cinc = Application.RoundUp(newW - oldW, 2)

       ' Find minimum effective RowHeight increment
       ' ==========================================

       oldH = Rows(1).RowHeight
       Builder = -0.001
       ' Try to make row shorter by incrementally larger
       ' amounts until it actually gets shorter:
       Do Until Rows(1).RowHeight < oldH
           Rows(1).RowHeight = Rows(1).RowHeight + Builder
           Builder = Builder - 0.001
       Loop
       newH = Rows(1).RowHeight
       ' Return row to its original height:
       Rows(1).RowHeight = oldH
       Rinc = -Application.RoundDown(newH - oldH, 2)

       ' Get Top.
       ' =======

       ScreenTop = ActiveWindow.VisibleRange.Rows(1).Top + _
           ADJUST_TOP_DOWNWARDS

       ' Get Left.
       ' ========

       ScreenLeft = ActiveWindow.VisibleRange.Columns(1).Left + _
           ADJUST_LEFT_SIDE_RIGHTWARD

       ' Get Width.
       ' =========

       LeftCol = ActiveWindow.VisibleRange.Columns(1).Column
       NumCols = ActiveWindow.VisibleRange.Columns.Count - 1
       ' If only one big column is visible:
       If NumCols = 0 Then
           Set LastCol = Columns(LeftCol)
          Cinc = Cinc * -1
       Else
          Set LastCol = Columns(LeftCol + NumCols - 1)
       End If
       OldCw = LastCol.ColumnWidth
       OldCsw = Columns(LastCol.Column).Width
       ' Change the column width until a column border crosses the
       ' right edge of the screen:
       Do Until ActiveWindow.VisibleRange.Columns.Count <> NumCols + 1
           LastCol.ColumnWidth = LastCol.ColumnWidth + Cinc
       Loop
       ' A small adjustment; your screen may vary:
       LastCol.ColumnWidth = LastCol.ColumnWidth + Abs(Cinc * 2)
       ' Add up the column widths:
       For Cadd = LeftCol To LastCol.Column
           ScreenWidth = ScreenWidth + Columns(Cadd).Width
       Next
       ' Return the column to its original width:
       LastCol.ColumnWidth = OldCw - _
           ADJUST_RIGHT_SIDE_LEFTWARD - ADJUST_LEFT_SIDE_RIGHTWARD

       ' Get Height.
       ' ==========

       TopRow = ActiveWindow.VisibleRange.Rows(1).Row
       NumRows = ActiveWindow.VisibleRange.Rows.Count - 1
       ' If only one big row is visible:
       If NumRows = 0 Then
           Set LastRow = Rows(TopRow)
           Rinc = Rinc * -1
       Else
           Set LastRow = Rows(TopRow + NumRows - 1)
       End If
       OldRh = LastRow.RowHeight
       ' Change the row height until a row border crosses the
       ' bottom edge of the screen:
       Do Until ActiveWindow.VisibleRange.Rows.Count <> NumRows + 1
           LastRow.RowHeight = LastRow.RowHeight + Rinc
       Loop
       ' A small adjustment; your screen may vary:
       LastRow.RowHeight = LastRow.RowHeight + Abs(Rinc * 2)
       ' Add up the row heights:
       For Radd = TopRow To LastRow.Row
           ScreenHeight = ScreenHeight + Rows(Radd).Height
       Next
       ' Return the row to its original height:
       LastRow.RowHeight = OldRh - _
           ADJUST_BOTTOM_UPWARDS - ADJUST_TOP_DOWNWARDS

       ' Sanity check.
       ' ============

       If ScreenWidth < 0 Then
           MsgBox "Cannot create rectangle." & Chr(13) & Chr(13) _
               & "ADJUST_TOP_DOWNWARDS and/or " & _
               "ADJUST_BOTTOM_UPWARDS is too high."
       ElseIf ScreenHeight < 0 Then
           MsgBox "Cannot create rectangle." & Chr(13) & Chr(13) _
               & "ADJUST_LEFT_SIDE_RIGHTWARD and/or " & _
               "ADJUST_RIGHT_SIDE_LEFTWARD is too high."
       Else

           ' Create an example object filling the viewable area.
           ' ==================================================
           ActiveSheet.Rectangles.Add(ScreenLeft, ScreenTop, ScreenWidth, _
               ScreenHeight).Select

       End If
   End Sub

REFERENCES

For more information about Ranges in Microsoft Excel, click the Search button in Help and type:

   VisibleRange


Additional query words: 5.00 5.00a 7.00 8.00 XL5 XL7 XL97 XL98
viewable showing shown unhidden not hidden appearing seeable exposed
unconcealed displayed
Keywords : kbcode kbprg PgmHowto
Version : WINDOWS:5.x,7.0,97; MACINTOSH:5.0,5.0a,98
Platform : MACINTOSH WINDOWS
Issue type : kbhowto


THE INFORMATION PROVIDED IN THE MICROSOFT KNOWLEDGE BASE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. MICROSOFT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING THE WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL MICROSOFT CORPORATION OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES WHATSOEVER INCLUDING DIRECT, INDIRECT, INCIDENTAL, CONSEQUENTIAL, LOSS OF BUSINESS PROFITS OR SPECIAL DAMAGES, EVEN IF MICROSOFT CORPORATION OR ITS SUPPLIERS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES SO THE FOREGOING LIMITATION MAY NOT APPLY.

Last reviewed: February 3, 1998
© 1998 Microsoft Corporation. All rights reserved. Terms of Use.