XL2000: How to Programmatically Measure the Visible Range in Points (213323)

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 professionals 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 a Microsoft Certified Partner or the Microsoft fee-based consulting line at (800) 936-5200. For more information about Microsoft Certified Partners, please visit the following Microsoft Web site: For more information about the support options that are available and about how to contact Microsoft, visit the following Microsoft Web site: To fill the visible range of a worksheet with a graphic object, such as a chart, you must know the exact top and left coordinates of the visible range, and the height and width of the visible range, in points.

The ActiveWindow.VisibleRange property returns the range, including any partially visible column to the right and any partially visible row at the bottom. You can use the Top and Left properties of that range to return the top and left coordinates, the width of all the columns except the one to the far right, and the height of all the rows except the bottom one.

Note that there is no direct way of obtaining the width of the visible portion of the column to the far right, or the height of the visible portion of the bottom row. The only way to obtain that information is to incrementally make the last column and bottom row wider or narrower until the ActiveWindow.VisibleRange property returns one greater or fewer number of columns and rows.

The width of a column is read-only. Therefore, you can widen a column only with the ColumnWidth property, which is measured based on the default font rather than in points (the default font may vary from computer to computer).

The ColumnWidth property can widen or narrow a column only by a minimum incremental amount; otherwise the column width does not change. You may need to experiment with a column to find the smallest amount by which it can be widened. Then, incrementally widen or narrow the column until the VisibleRange property returns one greater or fewer number of columns.

After you have determined this measurement, note the new column width and return the column to its original width.

Row size is easier to determine because the RowHeight property is measured in points; however, rows have a minimum incremental amount by which you can change them, and this amount can vary depending on the video adapter that you have installed in your computer.

To create a sample macro to return the exact visible range, follow these steps:

NOTE: This sample macro assumes that Excel is open to the worksheet with the range that you want to measure.

1. Press ALT+F11 to start the Visual Basic Editor.
2. On the Insert menu, click Module.
3. In the module sheet, type or paste the following code:

   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 needed.
   
   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