DuKiccoの雑記

My Life Is Myself

【セルの行高さや列幅をmmで指定する】【エクセル2013,VBA】

結論としてはセルの大きさは0.01mm単位での設定は難しいが0.1mm単位だとそれなりに近い値での設定が可能である。

 

エクセルの行の高さの単位はポイント、列の幅の単位は文字数となっている。「mm→ポイント」変換は用意されている関数を使えばよいので行の高さ設定について頭を悩ませることはないが、「mm→文字数」変換はフォントや環境(ディスプレー)などによって値がかわってくるのでかなりややこしい。さらに画面上でしっかり設定できたとしても、印刷の際にはプリンターに依存して微妙に大きさが変わる。これは、印刷されたセルのサイズを実際に測定し、印刷時の拡大縮小設定を調整することで対応するしかないようだ。

 

行の高さの設定

センチからポイントへはCentimetersToPoints関数を使用すればよい。

ただし、行の高さを手動でかえていくと、(自分の環境では)設定できる数字が0.25ポイント刻みであることがわかる。

例(9.5→9.5,9.6→9.5,9.7→9.75,9.8→9.85) 

 

ここでいったん長さの単位のおさらい

「1ポイント=1/72インチ

 1インチ=25.4mm

 0.25ポイント=25.4/72/4mm=0.088...mm」

という割り切れない中途半端な数字になっている。細かくmmで指定しても、結局は0.25ポイン刻みに丸められてしまうので0.1mm程度の誤差がでてしまう。

 

ちなみに画面の文字は小さな点(ピクセル)の集合であり、フォントや環境により文字あたりのピクセル数が異なる。大きさはピクセルの倍数かつ変更の最小単位は1ピクセルの大きさとなる。

 

列の幅の単位

列の幅の単位は文字数。0が何文字表示されるかを意味している。0の幅の値は設定されているフォントの種類・大きさ、および環境(ディスプレー)によって異なってくる。

 

列の幅の設定

VBAではプロパティから列幅を取得する2つのメソッドがある。「Columnwidth(単位:文字数)」と「Width(単位:ポイント)」である。Widthは値の取得のみで変更・設定できず、変更・設定できるのはColumnwidthだけである。なので「mm→ポイント→文字数」へと順に変換する必要が有る。「mm→ポイント」変換は行高さと同様に行えばよい。同一環境下ではポイントと文字数の関係はどうも「Y = aX + b」であらわされる”ようだ”(Y→ポイント、X→文字数、a,b→定数)。a,bは環境により異なる。言い換えると、「一定の余白(→b) + 一文字あたりの幅 (→a)X 文字数」ということらしい。a,bをどうやって求めるかだが、セルの幅を変化させ(Columnwidthに様々な値を入れる)たのち、Widthを1回ごとに取得し、それらの値をもとに計算すれば求めることができる(方法1)。また単純に最小の文字数から0.01文字(最小単位)ずつColumnwidthを増加させていきWidth値を監視し目的の幅(単位ポイント)になるまで増加させることで求めるやり方(方法2)も考えられる。方法1は数字の丸め(ピクセルの幅に調整される)が入ると微妙にずれる可能性が考えられ、方法2は力技すぎるので方法1で大体の数値を設定し方法2で微調整する方法をとることとした。くわえて方法1のとおりにaとbを求めるやり方だとゴテゴテするので若干不正確かもしれないがシンプルなコードを採用している。

 

===============================================================

Sub セルサイズ指定()
'
' 選択された各セルをmm単位で設定する。


Dim PointDelta As Double, EndN As Long, StepN As Long, NEARW As Double, NearD As Double, i As Long

Dim Buf As Range, tempW As Double, setteiRH As Double, setteiCW As Double, setteiCWP As Double

 

On Error GoTo ELH

Set Buf = Application.InputBox(PROMPT:="サイズを変更したい範囲を選択してください。", Type:=8)
Buf.Select

 

Application.ScreenUpdating = False

 

setteiRH = InputBox("各セルの行高さの設定値を入力(単位:mm)", "入力", 10) / 10

setteiCW = InputBox("各セルの列幅の設定値を入力(単位:mm)", "入力", 10) / 10

On Error GoTo ELH2
'RowHeghtを設定(高さはポイントをいれればよい。センチからポイントへはCentimetersToPoints関数を使用)
Selection.RowHeight = Application.CentimetersToPoints(setteiRH)


'setteiCWP →幅の設定値をcmからポイントへ変換

setteiCWP = Application.CentimetersToPoints(setteiCW)

 

'「X= (Y-b)/a」X(文字数)。bはYにくらべ十分小さく、1/aは「Selection(1).ColumnWidth / Selection(1).Width」に近い数字となる。またSelection(1).Widthと目的の値との差が小さいほどtempWが目的の値に近くなるため、ループさせることで1回ごとに正解に近づいていく。ColumnWidthの取りうる値が不連続なためだいたい3回くらいで目的の値にたどりつく。

For i = 1 To 5

tempW = setteiCWP * Selection(1).ColumnWidth / Selection(1).Width

Selection(1).ColumnWidth = tempW

Next

 

'ここまででほぼ完了。

 

'============ここから微調整のためのコード。しかし試したところ↑だけで目的の値になっていた。不要かもしれない(削除可)。===================

PointDelta = setteiCWP - Selection(1).Width

Select Case PointDelta
Case 0
Case Is < 0
EndN = -2000
StepN = -1
Case Is > 0
EndN = 2000
StepN = 1
End Select

 

NearD = PointDelta
NEARW = tempW

Debug.Print "差=設定値(ポイント)-実際の値(ポイント)=" & PointDelta

'0.001文字刻みで増減させていき最も設定値に近い幅を探索

For i = 0 To EndN Step StepN

Selection(1).ColumnWidth = tempW + i / 1000
If Abs(NearD) < Abs(setteiCWP - Selection(1).Width) Then
Exit For
Else
NearD = setteiCWP - Selection(1).Width
NEARW = tempW + i / 1000
End If

Next

Selection.ColumnWidth = NEARW

Debug.Print "ループした回数=" &  i
Debug.Print "ループ後の差=" &  NearD

'================微調整ここまで===================================

 

'数字が丸められた後の実際の値を表示。

MsgBox "完了" & Chr(13) & "丸められた後の幅(mm)=" & Selection(1).Width / Application.CentimetersToPoints(1) * 10 & Chr(13) & "丸められた後の高さ(mm)=" & Selection.RowHeight / Application.CentimetersToPoints(1) * 10

Application.ScreenUpdating = True

Exit Sub
ELH2:
MsgBox "設定可能な最大値を超えてるかも?"

Exit Sub

ELH:

MsgBox "終了"

End Sub