보고서용 슬라이드 매번 복사해서 붙여넣고 계신가요?
이제 엑셀에서 인쇄영역만 똑똑하게 추출해서 파워포인트로 자동 전환해보세요!
수작업은 그만! 단 1초면 OK! 🎉
💡 이 매크로가 뭐길래?
이 Excel VBA 매크로는 엑셀 파일 내 각 시트의 인쇄영역만 추출하여
슬라이드 형태로 PowerPoint 프레젠테이션으로 자동 저장해줍니다.
✔️ PPT 작업시간 90% 절감
✔️ 데이터 기반 보고서 제작에 최적
✔️ 엑셀 인쇄영역만 추출하기 때문에 깨끗한 슬라이드 출력!
✅ 주요 기능 한눈에 보기
기능설명
| 📄 인쇄영역만 추출 | 각 시트의 PageSetup.PrintArea 만 PPT에 삽입 |
| 🎯 자동 슬라이드 생성 | 시트 개수만큼 슬라이드 자동 생성 |
| 🔤 슬라이드 제목 삽입 | 슬라이드 좌측 상단에 시트 이름 삽입 |
| 🎨 크기 자동 조정 | 슬라이드에 맞춰 비율 유지하며 자동 맞춤 |
| 📁 자동 저장 | 엑셀 파일명과 같은 이름으로 .pptx 저장 |
🛠️ 사용 방법 (Step by Step)
- 매크로 삽입
- Alt + F11 → 모듈 추가 → 코드 붙여넣기
- 인쇄영역 설정
- 각 시트에서 출력할 범위를 페이지 레이아웃 > 인쇄영역 설정으로 지정
- 매크로 실행
- Alt + F8 → ExportSheetsToPowerPoint 실행
- 자동 실행 결과 확인
- PowerPoint 자동 실행 + .pptx 자동 저장 완료!
📦 출력물 예시
- 슬라이드마다 엑셀 시트 인쇄영역이 꽉 차게 삽입됨
- 상단에는 시트 이름이 제목처럼 삽입됨
- 원본 비율 유지로 데이터 왜곡 없이 깔끔하게 정렬
📌 파일 저장 위치
- PowerPoint 파일은 현재 엑셀 파일과 같은 경로에 자동 저장
- 예: 보고서.xlsx → 보고서.pptx
❗ 주의사항
- 인쇄영역이 없는 시트는 건너뜁니다 (자동 스킵)
- 숨겨진 시트는 자동 제외되어 안전하게 출력됩니다
- pptx 저장 형식으로 자동 저장되며 기존 파일은 덮어쓰지 않음
💬 활용 예시
- 👨💼 월간 보고서 요약본 PPT 출력
- 📊 실적/성과 데이터 시각화 발표 자료
- 🏗️ 공정 시트별 브리핑 슬라이드 생성
- 📚 교육 자료 PPT로 전환
🔧 VBA 코드
| Sub ExportSheetsToPowerPoint() Dim xlApp As Application Dim xlWB As Workbook Dim xlWS As Worksheet Dim pptApp As Object Dim pptPres As Object Dim pptSlide As Object Dim i As Integer Dim totalSheets As Integer Dim processedSheets As Integer Dim pptFileName As String Dim excelPath As String Dim excelName As String ' 에러 처리 추가 On Error GoTo ErrorHandler ' Excel 애플리케이션 및 워크북 설정 Set xlApp = Application Set xlWB = ActiveWorkbook ' 총 시트 수 저장 totalSheets = xlWB.Worksheets.Count processedSheets = 0 ' 엑셀 파일 경로와 이름 추출 excelPath = xlWB.Path excelName = Left(xlWB.Name, InStrRev(xlWB.Name, ".") - 1) ' 확장자 제거 pptFileName = excelPath & "\" & excelName & ".pptx" ' PowerPoint 애플리케이션 생성 On Error Resume Next Set pptApp = GetObject(, "PowerPoint.Application") If pptApp Is Nothing Then Set pptApp = CreateObject("PowerPoint.Application") End If On Error GoTo 0 ' PowerPoint를 화면에 표시 pptApp.Visible = True ' 새 프레젠테이션 생성 Set pptPres = pptApp.Presentations.Add ' 각 시트를 순회하며 슬라이드로 복사 For i = 1 To xlWB.Worksheets.Count Set xlWS = xlWB.Worksheets(i) ' 숨겨진 시트는 건너뛰기 If xlWS.Visible = xlSheetVisible Then Application.StatusBar = "처리 중: " & xlWS.Name & " (" & i & "/" & totalSheets & ")" ' 시트 선택 및 인쇄영역 복사 xlWS.Activate ' 인쇄영역이 설정되어 있는지 확인 If xlWS.PageSetup.PrintArea <> "" Then ' 인쇄영역 선택 및 복사 xlWS.Range(xlWS.PageSetup.PrintArea).Copy ' 새 슬라이드 추가 (빈 레이아웃) Set pptSlide = pptPres.Slides.Add(pptPres.Slides.Count + 1, 12) ' 12 = ppLayoutBlank ' 슬라이드에 붙여넣기 (그림으로) pptSlide.Shapes.PasteSpecial DataType:=2 ' ppPasteEnhancedMetafile ' 붙여넣은 개체의 크기와 위치 조정 If pptSlide.Shapes.Count > 0 Then With pptSlide.Shapes(pptSlide.Shapes.Count) ' 슬라이드 크기에 맞게 조정 (여백 고려) Dim slideWidth As Single Dim slideHeight As Single slideWidth = pptPres.PageSetup.slideWidth slideHeight = pptPres.PageSetup.slideHeight ' 비율을 유지하면서 크기 조정 Dim scaleWidth As Single Dim scaleHeight As Single scaleWidth = (slideWidth - 40) / .Width ' 좌우 여백 20씩 scaleHeight = (slideHeight - 40) / .Height ' 상하 여백 20씩 ' 더 작은 비율을 사용하여 슬라이드 안에 맞추기 Dim scaleRatio As Single scaleRatio = Application.Min(scaleWidth, scaleHeight) If scaleRatio < 1 Then .Width = .Width * scaleRatio .Height = .Height * scaleRatio End If ' 중앙 정렬 .Left = (slideWidth - .Width) / 2 .Top = (slideHeight - .Height) / 2 End With End If ' 슬라이드 제목 추가 (선택사항) Dim titleShape As Object Set titleShape = pptSlide.Shapes.AddTextbox(1, 10, 10, 200, 30) ' msoTextOrientationHorizontal = 1 With titleShape.TextFrame.TextRange .Text = xlWS.Name .Font.Size = 18 .Font.Bold = True End With Application.CutCopyMode = False processedSheets = processedSheets + 1 Else ' 인쇄영역이 설정되지 않은 경우 메시지 (선택사항) Debug.Print xlWS.Name & " 시트에는 인쇄영역이 설정되지 않았습니다." End If End If Next i ' 첫 번째 슬라이드로 이동 If pptPres.Slides.Count > 0 Then pptPres.Slides(1).Select End If ' PowerPoint 파일 저장 pptPres.SaveAs pptFileName ' 메시지 박스용 변수 저장 (객체 해제 전에) totalSheets = xlWB.Worksheets.Count ' 정리 Application.StatusBar = False Set xlWS = Nothing Set xlWB = Nothing Set xlApp = Nothing Set pptSlide = Nothing Set pptPres = Nothing Set pptApp = Nothing MsgBox "Excel 인쇄영역을 PowerPoint로 내보내기가 완료되었습니다!" & vbCrLf & _ "총 " & totalSheets & "개 시트 중 " & processedSheets & "개의 인쇄영역을 처리했습니다." & vbCrLf & _ "저장 위치: " & pptFileName, vbInformation Exit Sub ErrorHandler: Application.StatusBar = False Application.CutCopyMode = False MsgBox "오류가 발생했습니다: " & Err.Description & " (에러 번호: " & Err.Number & ")", vbCritical ' 객체 정리 On Error Resume Next Set xlWS = Nothing Set xlWB = Nothing Set xlApp = Nothing Set pptSlide = Nothing Set pptPres = Nothing Set pptApp = Nothing End Sub |