엑셀 파일로부터 프린텍 정부문서 V4320 양식으로 일괄 라벨 출력

 

 

공공기관은 연말에 문서 이관을 위해서 문서철 정리를 하는데요.

파일철에 제목이나 년도, 부서명을 프린트해서 붙이는 작업이 귀찮기 때문에

라벨지를 이용해서 문서제목, 부서명, 년도, 문서철 이름 등을 출력하면 편한데

정부문서 라벨 양식인 프린텍 v4320양식은 엑셀 일괄처리를 지원하지 않습니다.

​

프린텍 라벨입력 프로그램에서는 우편주소 같은 경우만 엑셀목록으로 일괄입력하는 것을 지원합니다.

v4320 형식의 경우는 제목, 부서, 년도, 문서철이름 등으로 여러가지 항목이 있고

특히 1페이지에 4개 세트를 담고 있어서 엑셀목록을 지원하지 않습니다.

​

---

 

 

이 때 파워포인트에 해당 양식을 기준 슬라이드로 1슬라이드에 만들고

VBA로 엑셀파일에서 목록을 읽어서

슬라이드를 추가하면서 자동으로 도형의 내용을 채워줄 수 있습니다.

 

(워드는 페이지 내용이 계속 이어지는 구조이지만

파워포인트는 슬라이드 단위 처리라서

워드보다 파워포인트가 이런 작업에서 편리합니다. )

 

 

 

​

1. 첨부파일을 다운로드 받아 파일속성에서 차단해제를 하시고 매크로를 허용하면서 pptm파일을 엽니다.

​

슬라이드에 4320 양식에 맞게 도형을 만들어야 합니다.

첨부파일 1슬라이드에 4320 양식으로 도형이 만들어져 있습니다.

참고로, 파워포인트에서 프린텍 등의 양식을 만드는 방법입니다. ​ 먼저 프린텍 라벨 프로그램을 다운 받아 설치하고 열어서 4320양식을 인쇄합니다. 인쇄할 때 PDF 프린터를 이용해서 PDF로 만들어줍니다. 이 PDF를 아래와 같은 사이트에서 pptx로 변환하면 됩니다. https://www.adobe.com/kr/acrobat/online/pdf-to-ppt.html https://online2pdf.com/pdf2pptx# https://www.ilovepdf.com/ko/pdf_to_powerpoint ​ 그리고 VBA에서 처리하기 쉽게 제목, 부서, 년도, 문서철이름1,문서철이름1 도형의 이름을 지정하고 그룹으로 묶어줍니다. 반드시 그룹으로 묶어줘야 매크로가 해당 그룹을 하나의 세트로 인식해서 처리합니다. 여기서는 간단히 title, dept, year, cat1, cat2 라는 이름으로 도형이름을 설정하고 그룹 이름도 1,2,3,4로 지정했습니다. 그리고 폰트 종류나 폰트 크기, 자간, 줄간격, 가로/세로 정렬, 텍스트 방향 등을 미리 설정해줍니다. 현재는 도형의 선이 보이는데 실제 작업에서는 도형 윤곽선을 '없음'으로 설정하세요.

 

 

 

여기서 첫번째 그룹의 도형의 텍스트나 도형 속성을 다른 그룹에 일괄로 적용하는 VBA를 이용하면 편리합니다.

첨부파일의 Z_CopyGroupChildFormat() 라는 매크로를 이용하면 됩니다.

첫번째 그룹의 내부도형의 폰트, 정렬, 간격, 여백 등을 나머지 그룹에도 복제/적용해줍니다.

​

Sub Z_CopyGroupChildFormat()
    Dim sld As Slide
    Dim srcGrp As Shape
    Dim grp As Shape
    Dim srcChild As Shape
    Dim tgtChild As Shape

    Set sld = ActiveWindow.View.Slide

    ' 슬라이드에서 첫 번째 그룹을 기준 그룹으로 설정
    For Each grp In sld.Shapes
        If grp.Type = msoGroup Then
            Set srcGrp = grp
            Exit For
        End If
    Next grp

    If srcGrp Is Nothing Then
        MsgBox "슬라이드에 그룹 도형이 없습니다."
        Exit Sub
    End If

    For Each grp In sld.Shapes
        If grp.Type = msoGroup And grp.Name <> srcGrp.Name Then
            For Each srcChild In srcGrp.GroupItems
                Set tgtChild = Nothing
                On Error Resume Next
                Set tgtChild = grp.GroupItems(srcChild.Name)
                On Error GoTo 0

                If Not tgtChild Is Nothing Then
                    srcChild.PickUp
                    tgtChild.Apply
                    tgtChild.TextFrame.TextRange.Text = srcChild.TextFrame.TextRange.Text
                End If
            Next srcChild
        End If
    Next grp

    MsgBox "첫번째 그룹의 서식 적용 완료"
End Sub

​

 

2. 그 다음 엑셀 목록을 준비합니다.

엑셀 1행의 각 열 제목은 기준 슬라이드의 그룹도형 내부의 각각 도형의 이름과 같아야 합니다.

​

3. Alt+F8을 누르고 A_FillSlidesFromExcel 매크로를 실행합니다.

파일선택 대화창이 열리면 대상 엑셀목록 파일을 선택합니다.

그러면 엑셀 내용대로 기준 슬라이드를 복제해서 각 도형에 내용을 채워줍니다.

​

아래처럼 1슬라이드가 복제되어 엑셀 내용대로 각 라벨 내용이 채워집니다.

​

도형의 선을 없애거나 폰트를 변경하려면

기준 슬라이드인 1슬라이드를 수정하고

다시 매크로를 실행해서

기존 슬라이드를 없애고 다시 생성하면 됩니다.

​

​
만약 기존 양식을 변경하거나 라벨 내용을 추가하려면 1슬라이드에 그룹 도형에 내부 도형을 추가하고
엑셀 파일에도 열을 추가하면 됩니다. 열 제목과 추가된 그룹내부도형의 이름이 같아야 합니다.

 

 

4. 이제 4320라벨지를 충분히 용지함에 넣고 인쇄합니다.

단면인쇄이고 숨겨진 슬라이드는 제외합니다.

전체페이지 슬라이드 누르고 '용지에 맞게 크기 조정'에 체크를 하게 되면

기존 크기보다 작아져서 폼 용지 틀에 맞지 않을 수 있으니 '용지에 맞게 크기 조정'에 체크 해제되어 있는지 확인하세요.

​메인 VBA코드:

Option Explicit

Sub A_FillSlidesFromExcel()
    Dim fd As FileDialog
    Dim xlApp As Object, xlWb As Object, xlWs As Object
    Dim xlPath As String
    Dim baseSld As Slide, curSld As Slide
    Dim shp As Shape, child As Shape, grps() As Shape
    Dim grpCount&, i&, lastRow&, lastCol&, r&, c&, pos&, usedCount&
    Dim headers() As String
 
    '0. 슬라이드가 2개 이상이면 기존 슬라이드 삭제 여부 확인
    If ActivePresentation.Slides.Count >= 2 Then
        If MsgBox("기존 슬라이드가 있습니다." & vbCrLf & _
                  "1번 슬라이드를 제외한 모든 슬라이드를 삭제할까요?", _
                  vbYesNo + vbQuestion, "슬라이드 삭제 확인") = vbYes Then
            For i = ActivePresentation.Slides.Count To 2 Step -1
                ActivePresentation.Slides(i).Delete
            Next i
        End If
    End If
  
    ' 1. 파일 열기 대화창
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "대상 엑셀 파일을 선택하세요"
        .AllowMultiSelect = False
        .InitialFileName = ActivePresentation.Path & "\"
        .Filters.Clear
        .Filters.Add "Excel 파일", "*.xlsx; *.xlsm; *.xls"
        If .Show <> -1 Then Exit Sub          ' 취소 시 종료
        xlPath = .SelectedItems(1)
    End With

    Set baseSld = ActivePresentation.Slides(1)

    ' 2. 기준 슬라이드의 그룹 도형 개수 미리 세기
    grpCount = 0
    For Each shp In baseSld.Shapes
        If shp.Type = msoGroup Then grpCount = grpCount + 1
    Next shp

    If grpCount = 0 Then
        MsgBox "1번 슬라이드에 그룹 도형이 없습니다."
        Exit Sub
    End If

    On Error GoTo CleanUp

    ' 3. 엑셀 열기
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    xlApp.DisplayAlerts = False
    Set xlWb = xlApp.Workbooks.Open(xlPath, , True)   ' 읽기 전용
    Set xlWs = xlWb.Worksheets(1)

    lastRow = xlWs.Cells(xlWs.Rows.Count, "A").End(-4162).Row            ' xlUp
    lastCol = xlWs.Cells(1, xlWs.Columns.Count).End(-4159).Column      ' xlToLeft

    If lastRow < 2 Then
        MsgBox "데이터 행이 없습니다."
        GoTo CleanUp
    End If

    ' 1행 헤더(자식 도형 이름) 읽기
    ReDim headers(1 To lastCol)
    For c = 1 To lastCol
        headers(c) = Trim(CStr(xlWs.Cells(1, c).Value))
    Next c

    ReDim grps(1 To grpCount)

    ' 4. A열 기준 2행 ~ 마지막 행 순환
    For r = 2 To lastRow
        pos = (r - 2) Mod grpCount          ' 0 ~ grpCount-1

        ' 첫 번째 그룹이거나 기존 슬라이드의 그룹을 모두 소진했으면 새 슬라이드 추가
        If pos = 0 Then
            Set curSld = baseSld.Duplicate(1)
            curSld.MoveTo ActivePresentation.Slides.Count
            
            ' 새 슬라이드의 그룹 도형 수집
            i = 0
            For Each shp In curSld.Shapes
                If shp.Type = msoGroup Then
                    i = i + 1
                    Set grps(i) = shp
                End If
            Next shp
        End If

        ' 그룹 내부 도형 중 헤더와 이름이 같은 도형에 값 입력
        For Each child In grps(pos + 1).GroupItems
            For c = 1 To lastCol
                If headers(c) <> "" Then
                    If child.Name = headers(c) Then
                        If child.HasTextFrame Then
                            child.TextFrame.TextRange.Text = CStr(xlWs.Cells(r, c).Text)
                        End If
                    End If
                End If
            Next c
        Next child
        
        curSld.SlideShowTransition.Hidden = msoFalse    '슬라이드 숨기기 취소
        usedCount = pos + 1
    Next r

    ' 5. 마지막 슬라이드에서 값이 채워지지 않은 그룹은 텍스트 제거
    For i = usedCount + 1 To grpCount
        For Each child In grps(i).GroupItems
            If child.HasTextFrame Then
                child.TextFrame.TextRange.Text = ""
            End If
        Next child
    Next i

    ' 6. 1번 슬라이드 숨김
    baseSld.SlideShowTransition.Hidden = msoTrue

    ' 7. 인쇄 옵션: 숨김 슬라이드 인쇄 안 함
    ActivePresentation.PrintOptions.PrintHiddenSlides = msoFalse

    MsgBox (lastRow - 1) & "개 행 처리 완료 (슬라이드 " & _
           ActivePresentation.Slides.Count - 1 & "장 생성)"

CleanUp:
    If Err.Number <> 0 Then MsgBox "오류 발생: " & Err.Description
    On Error Resume Next
    If Not xlWb Is Nothing Then xlWb.Close False
    If Not xlApp Is Nothing Then xlApp.Quit
    Set xlWs = Nothing: Set xlWb = Nothing: Set xlApp = Nothing
End Sub

 

 

 

 

4320.pptm과 4320목록.xls 파일을 첨부합니다.

 

4320.pptm

0.04MB

 

4320목록.xlsx

0.01MB

 

 

 

 

- Graphics generated by Gemini(tm)

- VBA coded by Claude(tm)