セルの高さの取得について

質問

エクセルで、セルの高さを取得についてですが、イミディエイト画面で、debug.print Worksheets("Sheet1").Range("A1:A3").Height とすると38.25と表示されます。"A1:A1900"とすると、24224.25となり"A1:A2000"で、24575.25となります。それ以後は、どんなにセル範囲広げても全て、24575.25の値しかかえって来ません。例えば、オートシェープで、A1:A30000の範囲を四角で囲もうとする場合、どのようにすればいいのでしょうか？24575.25の値だと途中までしか囲めません。(当然、ここのセルの高さがことなると数字も異なってきます)
宜しくお願い致します。

回答No.1

takana_ · ベストアンサー

以下の関数を作成し、イミディエイト画面で、debug.print GetHeight(Range("A1:A2000"))としてみてください。

'*****************************************************************************
'[ 関数名 ]　GetHeight
'[ 概 要 ]　Rangeの高さを取得
' Heightプロパティは32767以上の高さを計算出来ないため
'[ 引 数 ]　高さを取得するRange
'[ 戻り値 ]　高さ
'*****************************************************************************
Public Function GetHeight(ByRef objRange As Range) As Double
Dim lngCount As Long
Dim lngHalf As Long
Dim MaxHeight As Double '高さの最大値

MaxHeight = 32767 * 0.75
If objRange.Height < MaxHeight Then
GetHeight = objRange.Height
Else
With objRange
'前半＋後半の高さを合計
lngCount = .Rows.Count
lngHalf = lngCount / 2
GetHeight = GetHeight(Range(.Rows(1), .Rows(lngHalf))) + _
GetHeight(Range(.Rows(lngHalf + 1), .Rows(lngCount)))
End With
End If
End Function

回答No.2

zap35

とても姑息的ですが(^^;

Sub Macro2()
　ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 10, 10).Select
　Selection.Top = Range("A1").Top
　Selection.Left = Range("A1").Left
　Selection.Width = Range("A1").Width
　Selection.Height = Range("A30001").Top - Range("A1").Top
End Sub