다른 파일의 차트를 불러와 정렬하기

앞의 파일과 같은데

앞의 것은 이미지파일로 뺐다면 이번 작업은 별도의 시트를 만들어 차트를 가져오는 작업이다.

1. 각 파일의 각 시트를 순환하며 차트 생성

2. 시트에서 차트 생성이 완료되면 붙이고자 하는 시트로 잘라내서 붙이기

3. 5열씩 차트를 정렬

Option Explicit
Sub mkChart()
 
    Dim openFiles As Variant, openFile As Variant, xlsFile As String
    Dim wrkSht As Worksheet
    Dim rngArea As Range, testArea As Range
    Dim intR As Integer, intC As Integer
    Dim i As Integer, cntR As Integer
    Dim chtData As Range
    Dim oldWb As Workbook, newWb As Workbook
    Dim chT As Shape, objC As ChartObject
    Dim chtR As Integer, chtC As Integer, k As Integer
    Const chtWidth As Integer = 360, chtHeight As Integer = 216, chtGap As Integer = 10
    
    '작업속도 향상
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    
    Set oldWb = ActiveWorkbook
                    
    '기존 파일의 시트 삭제
    On Error Resume Next
        For i = 1 To Sheets.Count - 1
            Sheets(2).Delete
        Next i
    On Error GoTo 0
    Application.DisplayAlerts = True
                
    '과목별 시험 성적, 과목별 수행 등급 시트 생성
    For i = 1 To 2
        Sheets.Add after:=Sheets(Sheets.Count)
    Next i
    Sheets(2).Name = "과목별 시험 성적"
    Sheets(3).Name = "과목별 수행 등급"
    
    '파일불러오기
    xlsFile = "엑셀 파일 (*.xls*), *.xls*"
    openFiles = Application.GetOpenFilename(filefilter:=xlsFile, Title:="파일 선택", MultiSelect:=True)
    
    If IsArray(openFiles) = True Then
        
        For Each openFile In openFiles
            Workbooks.Open Filename:=openFile
            Set newWb = ActiveWorkbook
            
            '과목별 시험 성적과 과목별 수행 등급 시트만 작업
            For Each wrkSht In Worksheets
                If wrkSht.Name = "과목별 시험 성적" Or wrkSht.Name = "과목별 수행 등급" Then
                    wrkSht.Activate
    
                    '이름 영역, 과목영역 설정 및 데이터 열, 행 파악
                    Set rngArea = Range("C3", Cells(Rows.Count, "C").End(xlUp)).Offset(, -1)    '이름
                    Set testArea = Range("D2", Cells(2, Columns.Count).End(xlToLeft))   '과목
                    intR = rngArea.Rows.Count   '이름 행수
                    intC = testArea.Columns.Count + 1   '과목 열수
                    cntR = 1    '개인별 데이터영역
 
                    '이름영역의 마지막에서 처음으로 역으로 올라오며 작업(빈셀 때문)
                    For i = intR + 2 To 3 Step -1
        
                        '이름셀이 빈칸일 경우 학생별 행수를 1씩 늘려감
                        If Cells(i, "B") = "" Then cntR = cntR + 1
        
                        '이름셀에 값이 있을 경우
                        If Cells(i, "B") <> "" Then
        
                            '파일명 및 차트 영역 설정
                            Set chtData = Cells(i, "C").Resize(cntR, intC)
            
                            '차트 생성 후 서식 설정
                            ActiveSheet.Shapes.AddChart(Width:=chtWidth, Height:=chtHeight).Select
            
                            With ActiveChart
                                .SetSourceData Source:=chtData  '차트 소스
                                .ChartType = xlColumnClustered  '세로막대형 차트
                                .PlotBy = xlRows    '행방향으로 차트 설정
                                .Axes(Type:=xlCategory).CategoryNames = testArea 'X축 레이블은 과목명
                                .SetElement msoElementChartTitleAboveChart  '차트 위쪽에 제목 표시
                        
                                '차트 제목 서식
                                With .ChartTitle
                                    .Text = Cells(i, "B")
                                    .Format.TextFrame2.TextRange.Font.Size = 14
                                End With
                            End With
            
                            '개인별 데이터영역 초기화
                            cntR = 1
                        End If
                    Next i
                End If
            Next wrkSht
                
            '과목별 시험 성적 시트에 차트 이동
            Sheets("과목별 시험 성적").Activate
            For Each chT In ActiveSheet.Shapes
                If chT.Type = msoChart Then
                    chT.Select False
                End If
            Next chT
            Selection.Cut
            oldWb.Activate
            Sheets(2).Activate
            ActiveSheet.Paste
            
            '과목별 수행 등급 시트에 차트 이동
            newWb.Activate
            Sheets("과목별 수행 등급").Activate
            For Each chT In ActiveSheet.Shapes
                If chT.Type = msoChart Then
                    chT.Select False
                End If
            Next chT
            Selection.Cut
            oldWb.Activate
            Sheets(3).Activate
            ActiveSheet.Paste
            
            '과목별 시험 성적, 과목별 수행 등급 시트의 차트 정렬
            For i = 2 To 3
                k = 0
                Sheets(i).Activate
                
                '5열로 차트 불러옴
                For Each objC In ActiveSheet.ChartObjects
                    k = k + 1
                    chtR = Int((k - 1) / 5)
                    chtC = (k - 1) Mod 5
                    
                    With objC
                        .Left = (chtWidth + chtGap) * chtC
                        .Top = (chtHeight + chtGap) * chtR
                    End With
                Next objC
            Next i
            
            '작업한 파일은 닫고 다음 파일 작업
            newWb.Close SaveChanges:=False
        Next openFile
        
        MsgBox "작업을 완료하였습니다."
    
    '파일을 선택하지 않으면 매크로 종료
    Else
        Exit Sub
    End If
End Sub

차트불러오기.xlsm

A반.xlsx