Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


14098 / 76734 ←次へ | 前へ→

【68136】チャート作成について
質問  かな  - 11/2/4(金) 15:09 -

引用なし
パスワード
   今、ガントチャートをエクセルで作成しているのですが、
図形の直線の位置がうまくいかなくて悩んでいます
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("項目")
    'X軸の日付を取得
    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
    'Y軸の取得
    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


よろしくおねがいします
4 hits

【68136】チャート作成について かな 11/2/4(金) 15:09 質問
【68140】Re:チャート作成について 不明 11/2/4(金) 21:03 発言
【68156】Re:チャート作成について かな 11/2/7(月) 13:09 お礼
【68143】Re:チャート作成について kanabun 11/2/6(日) 16:47 発言
【68155】Re:チャート作成について かな 11/2/7(月) 13:05 お礼

14098 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free