Excelの荒技（その４） 行の高さを調整するVBA

ずっと以前から仕事でExcelを使っているのだが、使い方というよりも、MSの開発ポリシーの点で、理解できないことが多い。

その代表的なものが、画面上ではちゃんとセル内に収まっているのに、印刷すると字が隠れるという現象だ。これは、私がExcelを使い始めた15年前ぐらいから脈々と受け継がれているExcelの「仕様」で、このお蔭で、行の高さ調整・印刷プレビュー・印刷を延々と繰り返さなければならず、日本中で相当な資源（労力＆紙）が無駄になっているハズだ。

また、ご丁寧にも、行の高さや列幅を自動調整する機能（行間や列間でダブルクリックする）があるが、使っているフォントによっては行の高さが足りず、表示上においてすら見にくい場合がある。印刷用に頑張って高さ調整した後で、間違って「自動調整」してしまった暁には気が狂うしかない。

使わないお節介機能が次々と実装される中で、このような基本的「不具合」が未だに修正されないのは、「MSの社員は実は使っていないのでは？」と勘ぐりたくなる。
と、嘆いては見たものの、今やExcel抜きでは仕事にならないので使い続けている。

最近も、客先から受領したExcelファイルが、行数が多い上に文字がテンコ盛りで表示上も隠れまくっており、高さ調整する気にもならない。（と、言っても結局したが・・・）

行の高さを調整するマクロをWEB上で探してみたのであるが、VBAのサンプルコードっぽいのしか見つけられなかった。（実は、これまで、VBAはさわったこともなかったので、サンプルコードの実装の仕方すら解らなかった・・・ ）

そこで、意を決して、自分で作って見ることにした。
あまり、こんなことに時間を費やしたくなかったので、1週間、会社の休み時間にWEBでVBAのサンプルコードをかき集め、土曜日にそれらを参考に一気に書き上げた。

VBAの文法については、Z80の時代のBASIC言語（古っ！）の記憶とWEB上の情報を参照すれば、それほど悩むことはなかったが、VBA 独特の オブジェクト、特に Selection（Excelのセル選択）の扱いには相当手こずった。

例えば、Excel上で選択されたセルを順に処理するには

For Each 変数 in Selection

というループ処理を使うようなのであるが、この方法では、選択範囲が、単純な１つの矩形領域ではなく複数の跳び地であった場合は、セルを左上から順に拾ってくれず、選択した順番通りに拾われてしまう。その結果、選択の仕方によっては、同じ行や列が何度も繰り返し現れる場合があり、「行の高さを調整する」今回のプログラムのような「行単位の処理」には都合が悪い。
回避策をあれこれ考えたが、凝ったコードを書いてもうまくいかない例外ケースが出てしまうので、結局あまり難しいことは考えずに、（少々の例外ケースには目をつぶって）シンプルにいく方針とした。

主な仕様としては以下とした。

・　選択されたセル（の行）を対象に行の高さを広げる
・　広げ方は以下の3通りとする（1番目だけでもよいかも知れないがVBAの勉強も兼ねて）

1. 現在の高さの1.1倍とする
2. 最後に強制的に改行を挿入した後、高さを自動調整する
3. 列幅を0.8倍に変更 => 高さを自動調整 => 列幅を元に戻す
   　

まだ、ほとんどテストもできていないが、まず 1．のコードを載せておく。

１．現在の高さの1.1倍とする（倍率は可変）

Private Sub 行高さ定率変更(ByVal rate As Double)
    Dim a As Range
    Dim lastCell_Row As Long
    Dim sdHeight As Double
    Dim current_Height As Double
   
    '選択範囲のチェック
    If TypeName(Selection) <> "Range" Then
        MsgBox "対象セルを選択してから実行してください"
        Exit Sub
    End If
   
    '画面の更新を止める
    Application.ScreenUpdating = False
   
    '標準の行の高さ
    sdHeight = ActiveSheet.StandardHeight
    '最終有効行
    lastCell_Row = ActiveSheet.Cells.SpecialCells(xlLastCell).Row

    For Each a In Selection.Rows
        '最終有効行に達したら終わり
        If a.Row > lastCell_Row Then
            Exit Sub
        End If
       
        current_Height = a.RowHeight
        If current_Height <> sdHeight Then
            a.RowHeight = current_Height * rate
        End If
    Next a
   
End Sub

2. 以降は、次回とする。
近いうちに、3. まで含めた xla ファイルをアップする（つもり ）

【2009年4月26日追記】
続き（残りのコードとアドインファイル）をアップしました。
ココです。

では。