Excel VBA質問箱 IV

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

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


10167 / 76734 ←次へ | 前へ→

【72118】Re:散布図で画像をマーカ-位置に指定した角度で置きたい
発言  あすなろ  - 12/5/30(水) 22:58 -

引用なし
パスワード
   お邪魔します。
もう見ておられないかも知れませんが、

> 一方ではマーカーに絵を充てることは出来るが、角度を与えるようにはもともと出来ていない
> ので、VBAといえどもその限界を超えるのは難しい(出来ない?)と言うわけでしょうか。

順序を変えれば出来ます。予め角度を変えた絵(図形)を個々のマーカーに充てればいいです。
手動操作なら、(1)矢印を適当に描画、(2)角度を変える(図形の回転)、(3)その図形をコピー、
(4)マーカー1要素だけを選択、(5)貼り付け。(2)〜(5)の操作を要素の数だけ繰り返す。
但し、クリップボード経由のCopy&Pasteなので、時間がかかり実用向きではありません。

データX,Yの右隣列に角度データがあり、既に散布図が描画されている状態とします。
Sample1は、マーカーの中心を矢印の起点とする
Sample2は、マーカーの中心と矢印の中心を合わせる
両者とも、位置関係がわかるようにグラフを重ねて表示しています。

図形の矢印を使うと、矢じりの影響で位置が若干ずれるので、ブロック矢印を使用しています。
図形のRoatationプロパティは3時の位置が0度ですので適宜補正して下さい。

Sub Sample1()
  Dim newChart As Chart
  Dim oldChart As Chart
  Dim shp1 As Shape
  Dim shp2 As Shape
  Dim gShp As Shape
  Dim i As Long
  Dim fm
  Dim rng As Range
  Const ms As Long = 5
  Const d As Long = 20
  
  With ActiveSheet
    Set newChart = .ChartObjects(1).Chart
    fm = Split(newChart.SeriesCollection(1).Formula, ",")
    Set rng = Range(fm(2)).Offset(, 1)
    
    Set shp1 = .Shapes.AddShape(msoShapeRightArrow, 100, 100, d, ms)
    With shp1
      .Line.Weight = 0.5
      .Line.ForeColor.RGB = vbBlack
      .Fill.ForeColor.RGB = vbBlack
      If Val(Application.Version) > 11 Then
        .Adjustments.Item(1) = 0
        .Adjustments.Item(2) = 0.75
      Else
        .Adjustments.Item(1) = 0.8
        .Adjustments.Item(2) = 0.5
      End If
    End With
    Set shp2 = shp1.Duplicate
    With shp2
      .Left = shp1.Left - shp1.Width
      .Top = shp1.Top
      .Fill.Visible = False
      .Line.Visible = False
    End With
    Set gShp = .Shapes.Range(Array(shp1.Name, shp2.Name)).Group
  End With
  
  With newChart
    Set oldChart = .Parent.Duplicate.Chart
    oldChart.Parent.Top = .Parent.Top
    oldChart.Parent.Left = .Parent.Left
    .ChartArea.Fill.Visible = False
    .PlotArea.Fill.Visible = False
    .Parent.BringToFront
    For i = 1 To rng.Cells.Count
      gShp.Rotation = rng.Cells(i, 1).Value
      gShp.Copy
      .SeriesCollection(1).Points(i).Paste
    Next
  End With
  gShp.Delete
End Sub

Sub Sample2()
  Dim newChart As Chart
  Dim oldChart As Chart
  Dim shp1 As Shape
  Dim i As Long
  Dim fm
  Dim rng As Range
  Const ms As Long = 5
  Const d As Long = 20
  
  With ActiveSheet
    Set newChart = .ChartObjects(1).Chart
    fm = Split(newChart.SeriesCollection(1).Formula, ",")
    Set rng = Range(fm(2)).Offset(, 1)
    Set shp1 = .Shapes.AddShape(msoShapeRightArrow, 100, 100, d, ms)
  End With
  With shp1
    .Line.Weight = 0.5
    .Line.ForeColor.RGB = vbBlack
    .Fill.ForeColor.RGB = vbBlack
    If Val(Application.Version) > 11 Then
      .Adjustments.Item(1) = 0
      .Adjustments.Item(2) = 0.75
    Else
      .Adjustments.Item(1) = 0.8
      .Adjustments.Item(2) = 0.5
    End If
  End With
  With newChart
    Set oldChart = .Parent.Duplicate.Chart
    oldChart.Parent.Top = .Parent.Top
    oldChart.Parent.Left = .Parent.Left
    .ChartArea.Fill.Visible = False
    .PlotArea.Fill.Visible = False
    .Parent.BringToFront
    For i = 1 To rng.Cells.Count
      shp1.Rotation = rng.Cells(i, 1).Value
      shp1.Copy
      .SeriesCollection(1).Points(i).Paste
    Next
  End With
  shp1.Delete
End Sub

Sub Sample3()
  Dim newChart As Chart
  Dim oldChart As Chart
  Dim shp1 As Shape
  Dim i As Long
  Dim fm
  Dim rng As Range
  Const d As Long = 20
  
  With ActiveSheet
    Set newChart = .ChartObjects(1).Chart
    fm = Split(newChart.SeriesCollection(1).Formula, ",")
    Set rng = Range(fm(2)).Offset(, 1)
    Set shp1 = .Shapes.AddLine(100, 100, 100 + d, 100)
  End With
  With shp1.Line
    .Weight = 0.5
    .ForeColor.RGB = vbBlack
'    .EndArrowheadLength = msoArrowheadShort
'    .EndArrowheadStyle = msoArrowheadTriangle
'    .EndArrowheadWidth = msoArrowheadNarrow
  End With
  With newChart
    Set oldChart = .Parent.Duplicate.Chart
    oldChart.Parent.Top = .Parent.Top
    oldChart.Parent.Left = .Parent.Left
    .ChartArea.Fill.Visible = False
    .PlotArea.Fill.Visible = False
    .Parent.BringToFront
    For i = 1 To rng.Cells.Count
      shp1.Rotation = rng.Cells(i, 1).Value
      shp1.Copy
      .SeriesCollection(1).Points(i).Paste
    Next
  End With
  shp1.Delete
End Sub

4 hits

【72075】散布図で画像をマーカ-位置に指定した角度で置きたい 目指せマクロの達人 12/5/26(土) 19:35 質問
【72079】Re:散布図で画像をマーカ-位置に指定した角... rabbit 12/5/27(日) 11:06 発言
【72083】Re:散布図で画像をマーカ-位置に指定した角... 目指せマクロの達人 12/5/27(日) 14:17 発言
【72085】Re:散布図で画像をマーカ-位置に指定した角... rabbit 12/5/27(日) 16:51 発言
【72090】Re:散布図で画像をマーカ-位置に指定した角... 目指せマクロの達人 12/5/28(月) 17:44 発言
【72097】Re:散布図で画像をマーカ-位置に指定した角... 目指せマクロの達人 12/5/29(火) 12:53 発言
【72101】Re:散布図で画像をマーカ-位置に指定した角... kanabun 12/5/29(火) 17:08 発言
【72106】Re:散布図で画像をマーカ-位置に指定した角... 目指せマクロの達人 12/5/29(火) 22:55 お礼
【72089】Re:散布図で画像をマーカ-位置に指定した角... kanabun 12/5/28(月) 16:22 発言
【72091】Re:散布図で画像をマーカ-位置に指定した角... 目指せマクロの達人 12/5/28(月) 17:55 発言
【72117】Re:散布図で画像をマーカ-位置に指定した角... rabbit 12/5/30(水) 22:02 発言
【72118】Re:散布図で画像をマーカ-位置に指定した角... あすなろ 12/5/30(水) 22:58 発言
【72120】Re:散布図で画像をマーカ-位置に指定した角... kanabun 12/5/31(木) 8:45 発言
【72121】Re:散布図で画像をマーカ-位置に指定した角... マクロはひとまずコピペ 12/5/31(木) 17:01 お礼

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