Excel2000 VBA １行目に設定されている値(おおよその目安mm)でセル幅を変更する

Excel2000 VBA　１行目に設定されている値（単位mm）でセル幅を変更する

修正が必要なら修正する

一応できたバージョン、何かが間違っているバージョン複数のセルを設定した時に誤差が大きい（大よその目安と考える）
画面の物差しツール（定規）
http://www.vector.co.jp/soft/win95/art/se049514.html

この物差しツールを使って数値の微調整すると巧くいくのかも、、アイデアは良かったような気がするも駄目マクロと言うことで放置（試してみた方ｺﾞﾒﾝﾅｻｲ）

Sub ミリ単位でセル幅を設定()
'
'A1-P1に記入されている値（単位はmm）でセル幅を設定する
'

Dim cell_width(16) As Double    'アクティブセルに入力されている値(単位はmm),範囲はA1-P1とする
Dim syori As Integer            '
Dim x As Double                 '補正用
Dim count As Integer            'forループ用カウンター
Dim skip As String

'例　セルに100と記入されている時は、セル幅を100mm（印刷時)とする

x = 1.785                            'xの値は印刷して100mmになるように調整する

ActiveSheet.Select

'セルA1からP1に設定されている値を格納,ColumnWidth用に値を変換する

For count = 1 To 16
    cell_width(count) = Cells(1, count).Value
    cell_width(count) = cell_width(count) / x
Next count

'megboxを表示

syori = MsgBox("セル幅を変更するなら「はい」を押してください", vbYesNo)
 Select Case syori
    Case vbYes
        GoTo C_W
    Case vbNo
        Exit Sub
 End Select

'セル幅変更

C_W:

For count = 1 To 16
    If cell_width(count) = 0 Then GoTo skip  '値が設定されていない時はnext countへ
    If cell_width(count) > 255 Then GoTo errormsg
    Cells(1, count).ColumnWidth = cell_width(count)  'セル幅を変える
skip:
Next count
Exit Sub        '終了する

errormsg:
MsgBox "数値が不適切です"

End Sub

タグ：セル幅 Excel2000 VBA