Excel

앞의 팁에서 ‘게을러져라’라고 했는데 그 게으럼을 위하여 필요한 도구나 방법을
찾아내어 응용하는 것 즉 ‘필요는 발명의 어머니’입니다. 아래 팁에 달린 댓글에
댓글 달아주신 분이 필요해서 자료를 찾아보고 정리한 내용 올립니다.

http://www.clien.net/cs2/bbs/board.php?bo_table=lecture&wr_id=269998

저는 제가 필요할 때마다 검색하고 응용해서 사용하는 편이라 대부분의 초보사용자가
불편해 하는 부분을 잘 알 수가 없어요. 그래서 댓글이 달릴 때마다 혹은 개인적으로
메일을 보내오시는 분, 쪽지를 보내오시는 분의 요구사항을 해결해 드릴려고 합니다.

1. (x,y) 분산차트 그린다음에 개별 표식 옆에 별도 이름 입력하는거랑
2. 저렇게 동적으로 차트 생성한다음에 맨 마지막이나 특정중간 범위에 표식이랑 색깔
을 달리한다든가..
3. 동적차트 그린다음에 text 추가 삽입하는거.. 혹은 그 삽입 위치 지정같은거요..

우선 1. 분산챠트 부분은 그냥 영역선택하고 그래프 종류 선택해서 그리면 되지만
표식 옆에 다른 내용을 넣고자 하면 힘이 많이 들지요. 그래서 VBA로 넣고 싶은
내용을 자료와 연계해서 넣고 강조할 부분이 있으면 Marker 등을 변형해서 그 부분이
강조되게 하는 것입니다.

Option Explicit

Public dTime As Date

우선 차트를 그릴 영역을 선택하고 차트를 그립니다.

Sub ChartFromRange()

Dim myChtObj As ChartObject

Dim rngChtData As Range
Dim rngChtXVal As Range

Dim iColumn As Long

‘ 선택영역이 없으면 실행 중지
If TypeName(Selection) <> “Range” Then
MsgBox “영역을 선택하세요”
Exit Sub

End If

‘ 선택된 영역을 챠트데이터로 지정
Set rngChtData = Selection

‘ X값 재정의
With rngChtData
Set rngChtXVal = .Columns(1).Offset(1).Resize(.Rows.Count – 1)

End With

‘ 기존 차트가 있으면 삭제
For Each myChtObj In ActiveSheet.ChartObjects
If myChtObj.Name = “Chart 6” Then
myChtObj.Delete

End If
Next

‘ 챠트 생성
Set myChtObj = ActiveSheet.ChartObjects.Add _
(Left:=300, Width:=180, Top:=290, Height:=180)

myChtObj.Name = “Chart 6”

With myChtObj.Chart
‘ 분산형 챠트
.ChartType = xlXYScatter

‘ 다른 시리즈 제거
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete

Loop

‘ 세로축 만들기
With .Axes(xlCategory)
.HasMajorGridlines = True
.MajorGridlines.Border.Color = RGB(0, 0, 0)
.MajorGridlines.Border.LineStyle = xlContinuous

End With

‘ 범례 표시 보이지 않음
.HasLegend = False

‘ 강제로 제목을 보이지 않음. 기본으로 보이므로 보였다 안보이게
.HasTitle = True
.HasTitle = False

‘ 선택된 영역으로 차트 그리기
For iColumn = 2 To rngChtData.Columns.Count
With .SeriesCollection.NewSeries
.Values = rngChtXVal.Offset(, iColumn – 1)
.XValues = rngChtXVal
.Name = rngChtData(1, iColumn)

End With
Next

End With

‘ 챠트 꾸미기
Call ShadowMarker

‘ 차트에 값 표시
Call LabelXYValue

End Sub

챠트 꾸미기
Sub ShadowMarker()

Dim excChart As Chart
Dim excChartSeries As Series
Dim excPoint As Point

Set excChart = ActiveSheet.ChartObjects(“Chart 6”).Chart
Set excChartSeries = excChart.SeriesCollection(1)

With excChartSeries

‘그림자 설정
For Each excPoint In .Points
.Shadow = True
.MarkerBackgroundColor = RGB(255, 255, 255)
.MarkerForegroundColor = RGB(0, 176, 80)
.Format.Shadow.Type = msoShadow38
.Format.Shadow.Blur = 5
.Format.Shadow.ForeColor.RGB = RGB(0, 176, 80)
.MarkerSize = 12
.MarkerStyle = xlMarkerStyleCircle

Next

End With

End Sub

차트에 값 표시

Sub LabelXYValue()

Dim i As Integer, j As Integer

Dim excChart As Chart
Dim excShpTxt As Shape
Dim excChartSeries As Series
Dim cel As Range
Dim TempRng As Range

Dim vXValues As Variant
Dim vYValues As Variant

Dim iPt As Long
Dim YValMax As Double
Dim iPtMax As Long

Set TempRng = Range(“Ref_Rng”)

Set excChart = ActiveSheet.ChartObjects(“Chart 6”).Chart
Set excShpTxt = excChart.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 150, 12)
Set excChartSeries = excChart.SeriesCollection(1)

With excChart

excShpTxt.Left = .PlotArea.Left
excShpTxt.Top = .PlotArea.Top
excShpTxt.TextFrame.Characters.Font.Color = vbBlue

With excShpTxt.TextFrame2
.TextRange.Text = “특정 영역에 Text넣기”
.AutoSize = msoAutoSizeShapeToFitText

End With

vXValues = .SeriesCollection(1).XValues
vYValues = .SeriesCollection(1).Values

YValMax = vYValues(1)
iPtMax = 1

For iPt = 2 To UBound(vYValues)
If vYValues(iPt) > YValMax Then
YValMax = vYValues(iPt)
iPtMax = iPt

End If

Next

For i = 1 To .SeriesCollection(1).Points.Count

‘ With .SeriesCollection(1).Points(i)
‘ .ApplyDataLabels
‘
‘ If i = iPtMax Then
‘ .MarkerBackgroundColor = RGB(255, 0, 0)
‘ .MarkerForegroundColor = RGB(0, 0, 0)
‘ .Format.Shadow.Blur = 5
‘ .MarkerSize = 12
‘ .MarkerStyle = xlMarkerStyleDiamond
‘ .DataLabel.Text = “(” & vXValues(i) & “,” & vYValues(i) & “)”
‘
‘ Else
‘ .DataLabel.Text = “(” & vXValues(i) & “,” & vYValues(i) & “)”
‘
‘ End If
‘
‘ End With

With .SeriesCollection(1).Points(i)
.ApplyDataLabels

For Each cel In TempRng
If cel.Value = vXValues(i) Then
.DataLabel.Text = cel.Offset(0, 1).Value

End If
Next

End With

Next i

End With

Set cel = Nothing

Set TempRng = Nothing

End Sub

2. 동적차트에 특정 표시랑 색깔 다르게 하기
그냥 아이디어가 없어? R의 최대값과 Spec Out된 자료를 보여주는 정도로 했습니다.
아래 루틴에서 힌트를 얻어 다양한 방법으로 자료를 표시할 수 있으실 것입니다.

Sub LabelRMax()

Dim i As Integer

Dim excChart As Chart
Dim excShpTxt As Shape
Dim excChartSeries As Series

Dim vXValues As Variant
Dim vYValues As Variant

Dim iPt As Long
Dim YValMax As Double
Dim iPtMax As Long

Set excChart = ActiveSheet.ChartObjects(“Chart 5”).Chart
Set excChartSeries = excChart.SeriesCollection(2)

With excChart

With excChartSeries
.ApplyDataLabels
.MarkerStyle = xlMarkerStyleNone

.Format.Line.Visible = msoFalse
.Format.Line.Visible = msoTrue
.Format.Line.DashStyle = msoLineSolid
.Format.Line.ForeColor.RGB = RGB(255, 0, 0)
.Format.Line.Weight = 1#

End With

vYValues = .SeriesCollection(2).Values

YValMax = vYValues(1)
iPtMax = 1

‘ Y값이 최대값을 가지는 x값 찿음
For iPt = 2 To UBound(vYValues)
If vYValues(iPt) > YValMax Then
YValMax = vYValues(iPt)
iPtMax = iPt

End If

Next

For i = 1 To .SeriesCollection(2).Points.Count

With .SeriesCollection(2).Points(i)

‘ 최대값이면 표시, 이 부분에 조건을 넣어서 표시하면 됨
If i = iPtMax Then
.DataLabel.Font.Size = 10
.DataLabel.Font.Color = vbBlue
.DataLabel.Text = Format(vYValues(i), “0.00”)

Else
.DataLabel.Text = “”

End If

End With

Next i

End With

End Sub
Sub MarkerOutY()

Dim i As Integer, j As Integer

Dim excChart As Chart
Dim excChartSeries As Series

Dim vYValues As Variant
Dim Spec_Center As Long

Spec_Center = 42#

Set excChart = ActiveSheet.ChartObjects(“Chart 5”).Chart
Set excChartSeries = excChart.SeriesCollection(1)

With excChart

With excChartSeries
.ApplyDataLabels
.MarkerStyle = xlMarkerStyleNone

.Format.Line.Visible = msoFalse
.Format.Line.Visible = msoTrue
.Format.Line.DashStyle = msoLineSolid
.Format.Line.ForeColor.RGB = RGB(0, 0, 255)
.Format.Line.Weight = 1#

End With

vYValues = .SeriesCollection(1).Values

For i = 1 To .SeriesCollection(1).Points.Count

With .SeriesCollection(1).Points(i)

‘ Spec Out된 Y값 표시, 부분에 조건을 넣어서 표시하면 됨
If Abs(vYValues(i) – Spec_Center) > 3 Then
.DataLabel.Font.Size = 10
.DataLabel.Font.Color = vbRed
.DataLabel.Text = Format(vYValues(i), “0.00”)

Else
.DataLabel.Text = “”

End If

End With

Next i

End With

End Sub

Sub SetReDraw()

Dim ws As Worksheet

Set ws = Sheets(“Chart”)

On Error Resume Next

‘ 현재 시간 표시
ws.Cells(20, 8) = Now()

‘ 스크롤 위치 조정, ‘1’ 값을 조정하면 폭을 조절가능
Range(“스크롤”).Value = Range(“스크롤”).Value + 1

‘ 스크롤위치가 데이터크기보다 크면 리셋
If Range(“스크롤”).Value > Cells(20, 7).Value Then

Range(“스크롤”).Value = 1

End If

‘ 자동 스크롤 단위 시간, 분, 초
dTime = Now + TimeValue(“00:00:01”)

‘ R 최대값에 Label
Call LabelRMax

‘ 불량 데이터 표시
Call MarkerOutY

‘ 자동 스크롤
Application.OnTime dTime, “SetReDraw”

End Sub

Sub StopSetReDraw()

On Error Resume Next
‘ 자동 스크롤 중지
Application.OnTime dTime, “SetReDraw”, , False

End Sub

3. 3번은 고민중에 있습니다. 1초에 하나씩 Text가 생기고 또 없애야 해서
루틴의 아이디어를 찾아야 하는데 “게을러서… ” 해결되면 추가 수정해 두겠습니다.

언제나처럼 엑셀자료는 제 블로그에 올리겠습니다.

첨부 화일 : 20150507v1-Ani-Cht-Sct-Label