| |
▼rinn さん：
こんばんは。
>仕様書作成にはチャレンジしてみたいですが、どこから手をつけてどのようなものを作成すればいいかわかりませんのでそれも考え中です。
それは、rinnさんが この仕様書あるいは、マニュアルはわかりやすいと感じたものを
模倣すればよいのです。
>No イベントNo 部屋番号 入場日付 入場時間 退場日付 退場時間 料金
>1 4 1 2006/05/01 20:03 2006/05/01 21:50 \1000
>2 4 2 2006/04/30 23:00 2006/05/01 10:05 \3000
>3 4 2 2006/05/01 12:30 2006/05/01 13:10 \500
>4 5 3 2006/05/01 08:00 2006/05/01 15:40 \4500
例えば、上記のデータが新規ブックの「Sheet1」というシートの
セルＡ列からＨ列に入力されているとします。
（１行目は、項目名です）
部屋別の稼働状況は、Sheet2に作成します。
このSheet2の右側には、作業シートのSheet3があるものとします。
標準モジュールに
'============================================================
Const hh = 6 '目盛り列の巾数
'============================================================
Sub main()
Dim idx As Long
Dim rw As Long
Dim svrw As Long
Dim st As Single
Dim wk As Double
Dim shp As Shape
Dim cl As Long '四角の色
Dim eventno As Long
Dim shpnm As String
With ActiveSheet
.Columns("a").ColumnWidth = 11
.Columns("b:z").ColumnWidth = hh
.Range("a1").Value = #5/1/2006#
With .Range("b1:z1")
.Formula = "=column()-2&""時"""
.Value = .Value
End With
Call open_scale(2, 11, hh, .Columns("b").Width)
With Worksheets("sheet1")
idx = 2
svrw = 0
Do Until .Cells(idx, 1).Value = ""
rw = .Cells(idx, 3).Value + 1
wk = Application.Min(.Cells(idx, 6).Value + .Cells(idx, 7).Value, Range("a1").Value + 1) - _
Application.Max(.Cells(idx, 4).Value + .Cells(idx, 5).Value, Range("a1").Value)
If wk > 0 Then
If svrw <> rw Then
cl = 3
svrw = rw
Else
cl = cl + 1
End If
Cells(rw, 1).Value = .Cells(idx, 3).Value
st = (Application.Max(.Cells(idx, 4).Value + .Cells(idx, 5).Value, Range("a1").Value) _
- Int(Application.Max(.Cells(idx, 4).Value + .Cells(idx, 5).Value, Range("a1").Value))) * 24 * hh
Set shp = mk_rectangle(Rows(rw), st, wk * 24 * hh)
shpnm = "shp" & idx
eventno = .Cells(idx, 2).Value
With shp
.Name = shpnm
.TextFrame.Characters.Text = "イベントNO" & eventno
.TextFrame.HorizontalAlignment = xlHAlignCenter
.Fill.ForeColor.SchemeColor = cl
.Fill.Transparency = 0.75
End With
End If
idx = idx + 1
Loop
End With
End With
End Sub
別の標準モジュールに
'============================================================
Private st_col As Single
Private st_point As Single
Private myscale As Single
Private sswidth As Single
'============================================================
Sub open_scale(開始列, 開始列までのセル巾, 目盛り巾, 目盛りPnt)
' チャート作成するシート情報を登録する
' input : 開始列 --チャート作成開始列
' 開始列までのセル巾--- 列幅の合計値
' 目盛り巾------------目盛りとなる列の列幅
' 目盛りPnt-----------目盛りとなる列のWidth
st_col = 開始列
st_point = 開始列までのセル巾
myscale = 目盛り巾
sswidth = 目盛りPnt
End Sub
'============================================================
Function mk_rectangle(rng As Range, 開始 As Single, 巾 As Single, Optional sht As Worksheet = Nothing) As Shape
'指定された行に開始位置，巾の情報から、チャートを作成する
'input : rng---作成する行を表すRangeオブジェクト
' 開始---チャート作成開始位置を開始列からの列幅単位で指定
' 巾-----チャート作成巾を列幅単位で指定
' sht----チャートを作成するシートオブジェクト 尚、このシートの右のシートは作業シートとして
' 使用します。
' txtstr----チャートに記述する文字列
'output : mk_rectangle----作成したShapeオブジェクト
Dim mkleft As Single
Dim mkwidth As Single
If sht Is Nothing Then Set sht = ActiveSheet
wk = Int(開始 / myscale) * myscale
wk2 = (開始 - wk) / myscale
ha = Int(巾 / myscale) * myscale
ha2 = (巾 - ha) / myscale
cnv_left = get_point(wk + st_point, sht.Next)
cnv_width = get_point(ha, sht.Next)
If wk2 = 0 Then
mkleft = cnv_left + 3.75 * (st_col - 1 + Int((開始 - 0.1) / myscale))
Else
mkleft = cnv_left + 3.75 * (st_col - 1 + Int((wk - 0.1) / myscale)) + sswidth * wk2
End If
If ha2 = 0 Then
If ha = 0 Then
mkwidth = cnv_width
Else
mkwidth = cnv_width + 3.75 * Int((ha - 0.1) / myscale)
End If
Else
If ha = 0 Then
mkwidth = cnv_width + sswidth * ha2
Else
mkwidth = cnv_width + 3.75 * Int((ha - 0.1) / myscale) + sswidth * ha2
End If
End If
With rng
Set mk_rectangle = sht.Shapes.AddShape(msoShapeRectangle, mkleft, .Top, mkwidth, .Height)
End With
End Function
'============================================================
Function get_point(セル幅, sht As Worksheet)
With sht
.Cells(1, 1).ColumnWidth = セル幅
get_point = IIf(.Cells(1, 1).Width <= 0, 0, .Cells(1, 1).Width)
End With
End Function
として、Sheet2をアクティブにした状態で
mainを実行してみて下さい。
プログラムは、2006/5/1の部屋別の稼働状況を作成します。
>それとコードの件で質問があります。
>Function mk_rectangleの中の変数「wk」と「wk2」、「ha」と「ha2」が意味するのは何でしょうか？
>オートシェイプを時間の情報から作成している箇所であるというのはわかります。またその開始位置とオートシェイプの幅などを決めているというのもわかりますが、この関数の中で色々な計算がされていてちょっと混乱しています。
>上記4つの変数がどのような意味をもって定義されているのかわかればあともう一歩ではないかなと思います。
オートシェイプの作成は、スケールとなる列の幅（上記のコードでは､hh---＞6)を基準に
してポイントに変換して作成しています。
ところが、
新規ブックで以下のコード実行し見てください。
Sub test()
Columns("a").ColumnWidth = 12
Columns("b:c").ColumnWidth = 6
MsgBox Range("a1").Width & "-----" & Range("b1:c1").Width
End Sub
一つの列で列幅12の列と
二つの列で列幅6の列の列の横幅の合計ポイントは上記の結果が
示すように微妙に違いますよね？
この微妙な違いを考慮にいれないと正しい位置やスケールを持った
オートシェイプの作成ができません。
上記の変数はその補正計算を行うための計算に使用しています。
以上です。
|
|
ichinose
- 06/5/16(火) 23:54 -
