| |
▼B_BOSS さん：
こんばんは。
以下に示すコードを標準モジュールに貼り付けて実行してみて下さい。
対象は､アクティブシートです。
尚、アクティブシートの次のシート（右シート）を作業シートとして
使っていますから、フリーにしといてください。
'===================================================================
Private st_col
Private st_point
Private myscale
'===================================================================
Sub main()
With ActiveSheet
Call open_scale(3, 10, 10)
.Columns("a:b").ColumnWidth = 5
.Columns("c:u").ColumnWidth = 10
.Range("a1:a5").Value = Application.Transpose(Array("開始位置", 4, 28, 45, 60))
.Range("b1:b5").Value = Application.Transpose(Array("サイズ", 20, 10, 7, 5))
For idx = 2 To 5
Call mk_rectangle(.Rows(2), .Cells(idx, 1).Value, .Cells(idx, 2).Value)
Next
End With
End Sub
'================================================================
Sub open_scale(開始列, 開始列までのセル巾, 目盛り巾)
st_col = 開始列
st_point = 開始列までのセル巾
myscale = 目盛り巾
End Sub
'================================================================
Function mk_rectangle(rng As Range, 開始, 巾, Optional sht As Worksheet = Nothing) As Shape
If sht Is Nothing Then Set sht = ActiveSheet
cnv_left = get_point(開始 + st_point, sht.Next)
cnv_width = get_point(巾, sht.Next)
With rng
Set mk_rectangle = sht.Shapes.AddShape(msoShapeRectangle, _
cnv_left + 3.75 * (st_col - 1 + Int((開始 - 0.1) / myscale)), .Top, cnv_width + 3.75 * Int((巾 - 0.1) / myscale), .Height)
End With
End Function
'=====================================================
Function get_point(セル幅, sht As Worksheet)
With sht
.Cells(1, 1).ColumnWidth = セル幅
get_point = .Cells(1, 1).Width
End With
End Function
これで、プロシジャーmainを実行してみて下さい。
セルA2〜A5が開始位置のデータ、セルB2〜B5をサイズデータ
として、四角が作られるはずですが・・・。
確認してみて下さい。
|
|
