rand(life)
[VBA] 시트내 각 페이지를 여러 시트로 분리 본문
지식인 질문에 대한 답
"한 시트에 여러 페이지가 있는데, 각 페이지를 별개의 시트로 나누는 방법"에 대한 문의였다.
HpageBreak가 페이지 나누기니까, 그것을 기준으로 순환문을 돌리면 된다고 간단히 생각해서, 답변을 주려고 했는데
예제 파일을 보니 시트 안에 글자만 있는 것이 아니라 도형과 차트들이 들어있었다
문제는, 도형과 차트는 시트 복사를 하면 문자처럼 자동으로 같이 따라 오는 것이 아니라
각 개체별로 따로 복사해서 위치를 조정해주어야한다는 점이었다.
그래서 작업의 순서를 다음과 같이 잡았다
1. 페이지나누기 갯수대로 원본시트복사하기
2. 해당 각 페이지의 범위 설정 (eg. 2페이지는 15행~30행)
3. 범위에 들지 않는 페이지는 삭제 (2페이지가 아닌 1~14, 31~끝은 삭제)
4. 원본 시트에서 해당 범위에 있는 개체 찾기 (원본 시트에서 15~30행 사이에 있는 개체)
5. 해당 개체의 원본 시트에서의 위치 파악
6. 해당 개체 복사 붙여넣기
7. 개체의 위치 조정
그리고 그 결과는 아래와 같다.
빨간색 글씨로 된 부분이 해결하기가 어려웠던 부분이다.
특히 개체를 복사해서 붙였는데, 그 붙인 개체를 선택하기 위해서는
해당 시트를 활성화할 뿐만 아니라, 붙여넣을 셀도 활성화를 해야 비로소 붙여넣은 개체가 선택된다는 점을 알아내는데 오래걸렸다.
그리고 늘 도형의 위치를 셀에 맞추다보니 잊고 있었는데, 도형의 실제 위치는 셀에 어중간하게 걸쳐 있을때도 있어서,
Shape.Top이 Shape.TopLeftCell.Top과 일치하지 않을 수 있다는 것이다.
그래서 Single 변수로 그 둘의 차이를 받아두어야 정확한 위치가 잡힌다.
Option Explicit
Sub macro()
Dim h As HPageBreak
Dim s As Long, i As Long, ls As Long, le As Long, lsh As Long
Dim ws As Worksheet, wsS As Worksheet
Dim rng As Range, rngWss As Range
Dim sh As Shape
Dim sRngAddress As String
Dim sgDif As Single
Set wsS = ActiveSheet
Application.DisplayAlerts = False
For i = 1 To wsS.HPageBreaks.Count + 1 '페이지 수대로 시트 복사
wsS.Copy after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
ws.Name = i & "temp" '시트이름 임시로 부여
Next
For i = 1 To Sheets.Count - 1 '복사한 각 시트에 대해
Set ws = Sheets(i & "temp") '이름 설정
With ws
If .Name = "1temp" Then '첫행 찾기
ls = 1
Else
ls = .HPageBreaks(i - 1).Location.Row
End If
If .Name = CStr(Sheets.Count - 1) & "temp" Then '끝행 찾기
le = Rows.Count - 1
Else
le = .HPageBreaks(i).Location.Row
End If
Set rng = .Range(.Cells(ls, 1), .Cells(le, 1)).EntireRow '한 페이지 범위
sRngAddress = rng.Address '남길 페이지 범위 주소
.Range(.Cells(le, 1), .Cells(Rows.Count, 1)).EntireRow.Delete '아래쪽 지우기
If ls > 1 Then .Range(.Cells(1, 1), .Cells(ls - 1, 1)).EntireRow.Delete '위쪽 지우기
For Each sh In wsS.Shapes '원본 시트의 각 개체에 대해
Set rngWss = wsS.Range(sRngAddress) '남길 범위의 원본 시트에서
If Not Application.Intersect(rngWss, sh.TopLeftCell) Is Nothing Then '개체의 위치와 중복되면
sh.Copy '개체 복사
.Activate '붙여넣을 시트 활성화
.Range("A1").Activate 'A1셀을 활성화시킨 후 붙여야 붙은 개체가 선택이 됨
.Paste
lsh = sh.TopLeftCell.Row - ls + 1 '원본 시트와 옮겨질 시트의 행 차이
'2페이지가 15행부터 시작하고, 옮겨갈 개체가 원본에서 19행에 있다면
'옮겨갈 시트는 1페이지이므로 개체는 새 시트에서 19- 15 + 1 인 5행에 있어야한다
sgDif = sh.TopLeftCell.Top - sh.Top '개체의 행위치와 개체가 속한 셀의 위쪽 위치의 차이
With Selection '선택된 개체 위치 조정
.Top = Cells(lsh, 1).Top - sgDif
.Left = sh.Left
End With
End If
Next
End With
Next
Application.DisplayAlerts = True
MsgBox "완료"
End Sub
예시파일_답.xlsm
