'***************************************************

'    「ラベル貼りマクロ」 Macro
'***************************************************
'
' マクロ作成日 : 2001/9/17  ユーザー名 : Kenryo INDO
' マクロ修正日 : 2003/5/29  ユーザー名 : Kenryo INDO
'
'使い方：
'(1)VBAエディターを立ち上げ、当該プロジェクトの標準モジュールを挿入、
'(2)以下のプログラムを貼り付ける。
'(3)グラフかシートを選び、マクロ実行でnameLabelを選択。
'ただし前もってラベルにする範囲の入力を済ませておく。
'
' メイン： nameLabel()
' ラベリング作業： chartLabelSet()
' 書式変更：  shosikiLabel()
'

Sub nameLabel()
  
  Set myLabel = Application.InputBox( _
    prompt:="データラベルに使用するセル範囲を選択してください。", Type:=8)
  ActiveWorkbook.Names.Add Name:="chartLabels", RefersToR1C1:=myLabel
  chartLabelSet

End Sub


Sub chartLabelSet()
  Dim pts As Points
  Dim cLabels(20) As String

  Set chart1 = ActiveSheet.ChartObjects(1).Chart
  Set series1 = chart1.SeriesCollection(1)
  Set pts = series1.Points

  For K = 1 To pts.Count
    cLabels(K) = ActiveSheet.Range("chartLabels").Cells(K, 1).Value
  Next K

  ActiveSheet.ChartObjects(1).Activate
  ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabel, LegendKey:=False

  For K = 1 To pts.Count
    pts(K).DataLabel.Text = cLabels(K)
  Next K
   
  ActiveChart.SeriesCollection(1).DataLabels.Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .Position = xlLabelPositionLeft
        .Orientation = xlHorizontal
   '
      With Selection.Font
          .Name = "ＭＳ Ｐゴシック"
          .FontStyle = "太字"
          .Size = 8
          .Strikethrough = False
          .Superscript = False
          .Subscript = False
          .OutlineFont = False
          .Shadow = False
          .Underline = xlUnderlineStyleNone
          .ColorIndex = xlAutomatic
          .Background = xlAutomatic
      End With
    End With
'
End Sub


Sub shosikiLabel()

  Set Series = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)

  Series.DataLabels.Select
   'Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "太字"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
'   Selection.NumberFormatLocal = "G/標準"

End Sub