| |
▼かな さん：
こんにちは〜
>チャートの開始日付から、どんどん後ろの日付にいく度に、すこしづつ
>X軸の位置がずれていっているようです
>
>どこがいけないのか？
肝心の「日付の修正」関数が公開されていないので、
どうずれているかはわからないです。
ただ、「728日」といったら「104週」分であって、105週ではないですよね？
あと、描画範囲の 最初の日付〜最後の日付 に対応する
描画範囲の左端座標〜右端座標は 描画中変更はありませんから、
さいしょに一度だけ計算しておいて、共有変数に覚えておけば
位置の計算はもうすこし簡単になります。
'-----------------------------------------------------------
Option Explicit
Dim MINDay As Long '描画初期日
Dim MAXDay As Long '描画最終日
Dim MinPoint As Double '初期日に対応するPoint座標
Dim MaxPoint As Double '最終日に対応するPoint座標
Dim xCOEF As Double '日にち→セルPoint座標 変換係数
'----------------------------------------------------
Sub 作業()
Dim v As Variant
Dim i As Long
With Worksheets("項目")
With .Range("A1").CurrentRegion.Resize(8)
v = Intersect(.Cells, .Offset(1)).Value
End With
End With
With Worksheets("チャート")
.Activate
'ラインを削除
.Lines.Delete
'初期設定
MINDay = DateSerial(2011, 1, 1)
MAXDay = DateAdd("d", 105 * 7, MINDay) '105週分
MinPoint = .Columns(5).Left
MaxPoint = .Columns(5 + 105).Left
xCOEF = (MaxPoint - MinPoint) / (MAXDay - MINDay)
.Range("E4").Value2 = MINDay
'データのコピー
.Range("A5").Resize(UBound(v), 4).Value = v
For i = 1 To UBound(v)
If Not IsEmpty(v(i, 5)) And (v(i, 6) >= v(i, 5)) Then _
DrawBar i + 4, CLng(v(i, 5)), CLng(v(i, 6)), True
If Not IsEmpty(v(i, 7)) And (v(i, 8) >= v(i, 7)) Then _
DrawBar i + 4, CLng(v(i, 7)), CLng(v(i, 8)), False
Next
End With
End Sub
'----------------------------------------------------
Private Sub DrawBar(RowIndex As Long, day1 As Long, day2 As Long, _
is予定 As Boolean)
'描画位置用変数
Dim X1 As Double
Dim X2 As Double
Dim Y1 As Double
Dim Y2 As Double
'day1に対応するxPoint を求める
X1 = (day1 - MINDay) * xCOEF + MinPoint
'day2に対応するxPoint を求める
X2 = (day2 - MINDay) * xCOEF + MinPoint
With ActiveSheet.Rows(RowIndex)
Y1 = .Top + .Height * IIf(is予定, 1, 3) / 4
Y2 = Y1
End With
With ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2)
.Line.Weight = 5
.Line.DashStyle = IIf(is予定, msoLineSquareDot, msoLineSolid)
End With
End Sub
|
|
kanabun
- 11/2/6(日) 16:47 -
