Excel のセル結合を使うと行の高さが自動調整されない

Office2000 の Excel を使っている。行の高さは自動的に調整されてちょうど良い高さになってくれるが、ときどきそうならない場合があることに気づいた。印刷するとセルの末尾行が切れてしまったり、そもそも画面に表示されないので最後の一文の存在に気づかなかったりと、非常に使いにくい。

調べてみると、「セルの結合」の対象になっている場合は自動調整がされなくなるとのこと。なんでそんな仕様なんだろう? 不便だー。

マクロで行の高さを調整する方法もあるようだけど、そんな手間をかけたくない。

Excel VBA Q&A掲示板
http://www2.moug.net/app/bbs/message.php?cat=exvba&id=20 ...

特定のセルの内容が変わったらマクロを実行する

特定のセルに対して、入力された文字の量に合わせて、行高を自動変更するに
は、どのように記述したらいいでしょうか？
セル結合しているので、EXCEL機能の自動調整が使えません。


マイナーチェンジ版ッス
Option Explicit

Sub オートフィット()
    '特定のセルの結合されている範囲を取得．
    Dim rngTarget As Range: Set rngTarget = ActiveSheet.Range("A1").Me
rgeArea
    '特定のセルを，どこか好きなところへ複写．
    Dim rngTemp As Range: Set rngTemp = Worksheets("PRIVATE").Range("A
1")
    rngTemp.Worksheet.Cells.Clear
    rngTarget.Copy
    rngTemp.PasteSpecial Paste:=xlPasteAll
    '複写先を UnMerge．
    rngTemp.UnMerge
    rngTemp.Copy
    rngTemp.ClearContents
    rngTemp.Copy rngTemp.EntireColumn
    '特定のセルの Width を元に，複写先の ColumnWidth を変更．
    FitColumn rngTemp, rngTarget
    rngTemp.EntireRow.AutoFit
    'オートフィット後の高さ　の取得
    rngTarget.Copy rngTemp
    rngTemp.UnMerge
    rngTemp.EntireRow.AutoFit
    '複写先の Height を元に，結合されている範囲の Heightを変更．
    FitHeight rngTarget, rngTemp
End Sub

Private Sub FitColumn(ByVal 対象範囲 As Range, ByVal 目標Width As Rang
e)
    Dim 比率 As Double ' Width / ColumnWidth
    Dim 差分 As Double ' 対象範囲.Width - 目標Width.Width
    Dim Counter As Long '“差分”が収束しないときのガス抜き用
    Dim aColumn As Range
    Dim 幅 As Double '目標Width の ColumnWidth の和
    For Each aColumn In 目標Width.Columns
        幅 = 幅 + aColumn.ColumnWidth
    Next
    対象範囲.EntireColumn.ColumnWidth = 幅
    比率 = 対象範囲.Width / 対象範囲.ColumnWidth
    For Counter = 0 To 9
        差分 = (対象範囲.Width - 目標Width.Width) / 比率
        If Abs(差分) < 0.25 / 比率 Then Exit For
        対象範囲.EntireColumn.ColumnWidth = 対象範囲.EntireColumn.Colu
mnWidth - 差分
    Next
    Debug.Print 対象範囲.Width, 目標Width.Width, Counter
End Sub

Private Sub FitHeight(ByVal 対象範囲 As Range, ByVal 目標Height As Ran
ge)
    Dim Height1 As Double, Height2 As Double
    Dim 差分1 As Double, 差分2 As Double ' 対象範囲.Height - 目標Heigh
t.Height
    Height1 = 目標Height.RowHeight / 対象範囲.Rows.Count
    対象範囲.EntireRow.RowHeight = Height1
    Height1 = 対象範囲.EntireRow.RowHeight
    差分1 = 対象範囲.Height - 目標Height.Height
    Height2 = Height1 - Sgn(差分1) * 0.25
    対象範囲.EntireRow.RowHeight = Height2
    差分2 = 対象範囲.Height - 目標Height.Height
    If Abs(差分1) < Abs(差分2) Then
        対象範囲.EntireRow.RowHeight = Height1
    End If
    Debug.Print 対象範囲.Height, 目標Height.Height
End Sub

変数名に日本語を使うのってなかなか新鮮な感じがする。

新しいバージョンの Excel とか OpenOffice.org なら自動調整してくれるのかな。試す価値はあるかも。