5월 1 2015
엑셀(EXCEL) – 동적이름정의, Timer를 이용하여 Animation Chart 만들기
(Chart가 자동으로 화살표 방향으로 움직이는데 어떻게 표현할 방법이 없어서요)
(GIF로 올리고 싶지만 그만큼의 노력이 필요없을 것 같아서… 사실 게을러서 ㅠㅠ)
저는 업무를 하면서 직원들에게 ‘게을러 져라’라고 말하고 다닙니다.
어떤 일을 하게되면 한번만 하고 말 일이 있고 이것이 두번 세번 반복적으로 일어나면
이것을 양식화시켜 그것의 리스트를 만들고 그 업무의 프로세스를 정의하여 일을 하고
일이 도구나 치구를 사용해서 효율을 높일 수 있으면 개선 프로세스를 만들라고 합니다.
업무를 그냥 마냥 생각없이 하는 것과 프로세스를 만들어 효율화시키는 것은 큰 차이가
있습니다. ‘게을러 져라’는 말을 우회적으로 반복적인 일을 효율적으로 프로세스화시켜
잘 하라는 의미로 얘기합니다. 긍정적인 게으럼을 만들라는 이야기입니다.
ADO, 동적이름 정의를 통해서 데이터를 가져오는 팁을 올렸는데 놀고 있는 컴퓨터
놀리면 뭐합니까! 일 시켜야지요. 조금 더 수정해 내장타이머를 이용해서 자동으로
Chart를 Animation 시켜 볼려고 합니다.
이번 로직은 간단하네요. 몇 줄 안되는 코드를 응용하면 SQL SERVER에서 데이터를
불러와서 뿌려주고 그 자료를 Animation시켜서 사용할 수도 있습니다. 우선 개발도구
Visual Basic을 선택해서 Module을 추가해서 아래 코드를 넣어줍니다.
Option Explicit
Public dTime As Date
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”)
‘ 자동 스크롤
Application.OnTime dTime, “SetReDraw”
End Sub
Sub StopSetReDraw()
‘ 자동 스크롤 중지
Application.OnTime dTime, “SetReDraw”, , False
End Sub
그리고 Chart시트에 개발도구 > 삽입 > 양식컨트롤 – 단추를 두개 만들어 줍니다.
한 곳에는 SetReDraw Macro를 적용하고 한 곳에는 StopSetReDraw를 적용합니다.
그리고 버튼을 누르면 Chart가 자동으로 움직입니다.
첨부화일 20150430-애니메이션차트만들기
5월 7 2015
엑셀(EXCEL) – Animation Chart의 데이터 강조 및 분산 챠트의 다양한 표시법
앞의 팁에서 ‘게을러져라’라고 했는데 그 게으럼을 위하여 필요한 도구나 방법을
찾아내어 응용하는 것 즉 ‘필요는 발명의 어머니’입니다. 아래 팁에 달린 댓글에
댓글 달아주신 분이 필요해서 자료를 찾아보고 정리한 내용 올립니다.
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
By vinipapa • 무른모 • 0 • Tags: Excel, 데이터 강조, 분산챠트, 애니메이션차트, 엑셀