Excel VBA質問箱 IV

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

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


42266 / 76732 ←次へ | 前へ→

【39537】ワークシート上グラフのデータラベル表示
質問  わいわい  - 06/6/26(月) 13:39 -

引用なし
パスワード
   いつもお世話になります。前回の質問ではお礼も述べず放置してしまい申し訳ありませんでした。皆さんに回答して頂き、マクロの機能としては揃いましたので各動作の最適化、軽量化を進めようと思い見直すとやはり作図の部分がネックになります。中でも”データラベル”の表示作業が重いようなので、これについて教えてください。
やりたいことは、ある2点間を線で結び一方の点に任意の文字を表示させると言うものです。2点がそのつど位置が変わり、固定されない複数SETであるため、TextBox等では難しいと考えデータラベルを配置しTEXTを書き換えるという方法を選びました。しかし一度、線を挿入した後これを選択し書き換えると言う方法のため、(例では72本ですが)描画に非常に時間がかかります。
参考リストを掲載しますのでアドバイス宜しくお願いいたします。

Sub MakeDATA()'作図用のデータをSheet1に作ります。
  For i = 0 To 71
    With Worksheets("Sheet1")
      .Cells(4 + i, 1).Value = i * 5
      .Cells(4 + i, 2) = 0
      .Cells(4 + i, 3) = "=10*COS(PI()*RC[-2]/180)"
      .Cells(4 + i, 4) = 0
      .Cells(4 + i, 5) = "=10*sin(PI()*RC[-4]/180)"
    End With
  Next i
End Sub

Sub MakeCharts() '作図用のグラフ1をsheet1に作ります。
  Worksheets("Sheet1").Select
  Charts.Add
  With ActiveChart
    .ChartType = xlXYScatter
    .SetSourceData Source:=Sheets("Sheet1").Range("I12")
    .Location Where:=xlLocationAsObject, Name:="Sheet1"
  End With
End Sub

Sub 描画() '本題の作図作業を行います。
  Dim Ch As ChartObject
  Dim DL_Name As Variant
  Dim i As Integer, j As Integer, k As Integer, Line_Color As Integer
  Dim l As Double, m As Double
  
  Set Ch = ActiveSheet.ChartObjects("グラフ 1")

  Application.ScreenUpdating = False '画面更新停止し、ちょびっと高速化

  i = Ch.Chart.SeriesCollection.Count + 1
  j = 4
  k = Worksheets("Sheet1").Range("B4").End(xlDown).Row
  
  While j <= k
    With Ch.Chart.SeriesCollection.NewSeries
      .XValues = "=Sheet1!R" & j & "C2:R" & j & "C3"
      .Values = "=Sheet1!R" & j & "C4:R" & j & "C5"
      .Name = "No_" & j
      .Border.ColorIndex = 1
      .Border.Weight = xlHairline
      .Border.LineStyle = xlContinuous
    End With
'−−−直線の2番目の点にのみラベル表示(数値は任意:今回は角度)−−−
    Set DL_Name = Ch.Chart.SeriesCollection(i).Points(2).DataLabel
  
    Ch.Chart.SeriesCollection(i).Points(2).ApplyDataLabels Type:= _
        xlDataLabelsShowLabel, AutoText:=True, LegendKey:=False
    DL_Name.Characters.Text = Worksheets("Sheet1").Cells(j, 1).Value
    DL_Name.AutoScaleFont = False
    With DL_Name.Characters(Start:=1, Length:=4).Font
      .Name = "MS Pゴシック"
      .Size = 8
    End With
    i = i + 1: j = j + 1
'−−−−−−−−−−−−−−−−−−−−−−−−−−
  Wend
  
  Application.ScreenUpdating = True  '画面更新再開
  Set Ch = Nothing          'クリアー
  Set DL_Name = Nothing        'クリアー
End Sub

Sub 線消去()
  Dim Ch As ChartObject
  Dim i As Integer
    
  Set Ch = ActiveSheet.ChartObjects("グラフ 1")
  i = Ch.Chart.SeriesCollection.Count
  Application.ScreenUpdating = False
  While i > 0
    Ch.Chart.SeriesCollection(i).Delete
    i = i - 1
  Wend
  Application.ScreenUpdating = True
  Set Ch = Nothing
End Sub

>書式設定は、デフォルトの設定では目的と違って、実現しないようなものについて
>のみ行えば良いのです。
についてですが、例えば1〜50番目までは直線、51番目から破線と言うようなとき50番目の描画が終わった時点でデフォールト設定を破線へと変更できるものなのでしょうか?こちらについても解答お願いします。

3 hits

【36413】任意の本数のグラフを作成 わいわい 06/3/30(木) 17:15 質問
【36414】Re:任意の本数のグラフを作成 Kein 06/3/30(木) 17:28 回答
【36419】Re:任意の本数のグラフを作成 わいわい 06/3/30(木) 18:01 お礼
【36727】グラフ描画のスピードUP わいわい 06/4/11(火) 10:21 質問
【36735】Re:グラフ描画のスピードUP Kein 06/4/11(火) 14:02 回答
【39537】ワークシート上グラフのデータラベル表示 わいわい 06/6/26(月) 13:39 質問

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