| |
今、ガントチャートをエクセルで作成しているのですが、
図形の直線の位置がうまくいかなくて悩んでいます
X軸の取得方法がうまくいってないようなんですが、
チャートの開始日付から、どんどん後ろの日付にいく度に、すこしづつ
X軸の位置がずれていっているようです
どうか、どこがいけないのか？アドバイスお願いします
シート【項目】
A列;No.
B列;分類
C列;品目
D列;個数
E列;開始予定
F列;終了予定
G列;開始実績
H列;終了実績
が入っています
シート【チャート】
A列からD列まで、シート【項目】の情報を転記し、
E列からチャートを作成
開始日-終了日を直線（オートシェイプ）を使用して表示
チャート表示の開始日が、
2011/1/1
チャート表示の終了日が
2012/12/29
728日（2年分）のチャート日数ですが、列数が足りなくなるため、
1列（1セル幅）を7日ピッチで表示させてあり、
チャートの列数は105列としてあります
例えば
予定開始日：2011/1/1 予定終了日；2011/1/5
の場合の直線の配置はうまくいくのですが、
日付があとのほうになればなるほど、どんどんX軸の位置後ろへずれていってしまいます
現在のコードです
Dim CHART_ROW As Integer 'チャート開始行
Dim CHART_COL As Integer 'チャート開始列
Dim CHART_DATE As Date '開始日
Dim CHART_NAME As String 'チャート名称
------------------------------------------------------------
Sub 変数初期化()
CHART_ROW = 5
CHART_COL = 5
CHART_DATE = Sheets("チャート").Cells(4, 5).Value
CHART_NAME = "CHART"
End Sub
------------------------------------------------------------
'項目データ取得
Sub 項目データ取得()
Dim I As Integer
Dim MaxRow As Integer
Sheets("チャート").Activate
With .Sheets("項目")
For I = 2 To .Range("A" & Rows.Count).End(xlUp).Row
MaxRow = Range("A" & Rows.Count).End(xlUp).Row + 1
.Range(.Cells(I, "A"), .Cells(I, "D")).Copy Destination:= _
Sheets("チャート").Cells(MaxRow, "A")
'チャート描画処理
チャート描画 I, MaxRow, True '項目対象行、チャート対象行、予定
チャート描画 I, MaxRow, False '項目対象行、チャート対象行、実績
Next
End With
End Sub
-------------------------------------------------------------------------
'チャート描画処理
Sub チャート描画(項目行 As Integer, チャート行 As Integer, 予定 As Boolean)
Dim I As Integer
Dim J As Double
'描画位置用変数
Dim X1 As Double
Dim X2 As Double
Dim Y1 As Double
Dim Y2 As Double
'チャートの全期間幅用変数
Dim X0 As Double
'予定と実績の別を判断
If 予定 Then
I = 0
Else
I = 2
End If
'チャート728日数の設定
J = 728#
'チャートの全期間の幅を取得(チャート列数105列分）
X0 = Sheets("チャート").Columns(CHART_COL + 105#).Left - _
Sheets("チャート").Columns(CHART_COL).Left
With Sheests("項目")
'Ｘ軸の日付を取得
X1 = .Cells(項目行, 5 + I).Value - CHART_DATE
X2 = .Cells(項目行, 6 + I).Value - CHART_DATE
'日付の修正と描画位置への変換
X1 = 日付の修正(X1, 0, J) * X0 / J + Sheets("チャート").Columns(CHART_COL).Left
X2 = 日付の修正(X2, 0, J) * X0 / J + Sheets("チャート").Columns(CHART_COL).Left
'予定と実績の別を判断
If 予定 Then
I = 1
Else
I = 3
End If
'Ｙ軸の取得
Y1 = Sheets("チャート").Rows(チャート行).Top + _
Sheets("チャート").Rows(チャート行).Height * I / 4
Y2 = Y1
'線の描画
線の追加 X1, Y1, X2, Y2, 予定
End With
End Sub
---------------------------------------------------------------------
'チャート用線の追加マクロ
Sub 線の追加(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double, _
予定 As Boolean)
Const 線の太さ = 5#
'線の追加と設定
ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Select
Selection.ShapeRange.Line.Weight = 線の太さ
If 予定 Then
Selection.ShapeRange.Line.DashStyle = msoLineSquareDot
Else
Selection.ShapeRange.Line.DashStyle = msoLineSolid
End If
Selection.Name = CHART_NAME
End Sub
'-----------------------------------------------------------
Sub チャート作成()
Sheets("チャート").Select
変数初期化
項目データ取得
End Sub
よろしくおねがいします
|
|
かな
- 11/2/4(金) 15:09 -
