ColumnWidthではセンチなどの決まった値を設定できない
セルの幅を設定するにはColumnWidthプロパティを利用しますが、設定値が文字数になっています。
ところが実際に幅を設定する場合は「3センチの幅にしたい」というような確定した単位の設定を行いたいことがあります。
そのような場合、文字数を設定するColumnWidthではどういう値を設定すればよいのか分かりにくいです。
また、その文字数は「標準フォントの半角数字の0を1文字とする」という妙な仕様です。この仕様によりExcelのオプション設定のフォントの種類やフォントサイズが違うと1文字の幅が変わってしまいます。
このため、ColumnWidth = 10 というコードの結果がPC環境によっては1センチだったり2センチだったりと変わってしまうことになります。
そこで、環境によって値が変動しないポイント数から文字数を算出する方法を考えます。
ポイントから文字数の算出には工夫が必要
セルの幅のポイント数はWidthプロパティで取得できます。Widthプロパティで幅を設定できればいいのですが、取得しか出来ません。あくまでも幅の設定は文字数を設定するColumnWidthプロパティで行うしかありません。
問題なのはどうやってポイント数から文字数を算出するかです。ちょっと面倒です。
何が面倒なのかというと、オプションの設定でフォントの種類やサイズを変更できるため、それらに応じて幅の文字数単位も変わってきます。それを考慮しなければなりません。
とは言っても、ColumnWitdhプロパティで文字数を指定しなければ他に幅を変更する手段がないため、文字数はどうしても必要になります。
ネットでは「100ピクセルは11.88文字だからそれを元に算出すればよい」とか「幅8.38は72ピクセル」という内容を見かけるのですが、これはフォントがMS Pゴシックでフォントサイズが11ポイントの場合に限定されているため、フォントが変更されている場合には当然ながら対応できません。
また、「ディスプレイの解像度やプリンターに依存するから分からない」という内容も見かけますが、これも誤りで外部機器は関係ありません。
以下はフォントの種類やサイズに関係なく、ポイント数からColumnWidthに設定する文字数を取得するマクロです。
ポイント数から文字数を算出する関数
以下の関数は、指定したポイント数から幅の文字数を算出します。
Excelのオプション設定でフォントの種類やサイズが変更されていても問題ありません。
この関数を使った場合、一般的なMS Pゴシックの11ポイントの場合で、75ポイント(100ピクセル)の文字数を取得すると第二引数に11.88が設定されます。
なお、指定したポイント数がExcelの許容外の場合のエラー処理は入れていません。
もしA1セルが利用できないような場合は、一時的にシートを追加してそのシートのA1セルを利用し、文字数算出後に追加したシートを削除するなどの対応をしてみてください。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
'// 引数1(I):文字数に変換するポイント数を指定 '// 引数2(O):ポイント数から算出した幅(文字数) Sub PointToCharCount(a_iPoint, a_dCharCount) Dim dStartHeight '// 変更前の高さ(後で戻す用) Dim dStartWidth '// 変更前の幅(後で戻す用) Dim dNowHeight '// 高さ Dim dNowWidth '// 幅 Dim i '// ループカウンタ Dim r As Range '// 指定セルのRangeオブジェクト Set r = Range("A1") dStartHeight = r.RowHeight dStartWidth = r.ColumnWidth '// 1度ではColumnWidthが正しく設定されないためループ。だいたい3回目で正しくなる様子。 For i = 0 To 10 '// セルの高さと幅をポイント単位で取得 dNowHeight = r.Height dNowWidth = r.Width '// 指定ポイント数に高さと幅を変更 '// (ポイント数 / 高さor幅)は、現在の高さor幅に対する係数 r.RowHeight = r.RowHeight * (a_iPoint / dNowHeight) r.ColumnWidth = r.ColumnWidth * (a_iPoint / dNowWidth) '// B2セルの上と左のピクセルが同じであれば、 '// A1セルの幅が正しく設定されたとみなす If (r.Offset(1, 1).Top = r.Offset(1, 1).Left) Then Exit For End If Next '// この時点で指定ポイントの幅が何文字なのかが分かる。 a_dCharCount = r.ColumnWidth '// 元に戻す r.RowHeight = dStartHeight r.ColumnWidth = dStartWidth End Sub |
この処理はちょっと変わったことをやっているため少し説明します。
A1セルの高さと幅を指定ポイントの割合だけ変更し、真四角の状態にします。その結果、A1の右下のB2のセルと上と左の位置が同じであれば、ちゃんと幅を設定できたとみなしています。
なぜ真四角にしているのかというと、高さを設定するRowHeightプロパティはポイント数で設定するため指定値をそのまま設定できるのですが、ColumnWidthプロパティで設定される幅はポイント数から文字数に変換される際に、高さとは異なるピクセルになることがあります。微妙な誤差ですが、ピクセル単位では数ピクセルずれが生じています。
そこでループ処理を入れて、誤差を縮めて正しい値に合わせています。ループを抜けてA1セルが真四角の状態になるとその時点の幅のピクセル(ポイントではなくピクセル)が設定したい幅になります。
B2セルで取得しているTopプロパティとLeftプロパティは、B2セルの上と左のピクセルを取得しているのですが、言い方を変えればA1セルの高さと幅をピクセル数で取得している意味になります。そのことを利用して、真四角(幅が正しく設定されている)かどうかの判定を行っています。
ポイント数ではなく各単位で統一が取れるピクセル単位で高さや幅の設定を行うことが出来ればいいのですが、そういうメソッドやプロパティが用意されていません。本来は変換関数とか用意してもらえるといいんですけどね。
使い方
A1セルの幅をWidthプロパティでポイントとして渡して、文字数を受け取るテストコードです。
1 2 3 4 5 |
Sub PixelToCharCountTest() Dim dCharCount Call PixelToCharCount(Range("A1").Width, dCharCount) Debug.Print dCharCount End Sub |