엑셀 명단 이용하여 PPT 명찰 출력(ppt 메일 머지)

 

아래한/글의 메일 머지는 '{{1}}, {{2}}, {{이름}}'처럼 텍스트 문구에 쓰인 {{필드번호/필드명}}에 해당 데이터를 찾아 그 위치에 삽입하는 방식입니다.

​

파워포인트에서 제 그동안의 방식은 Alt+F10 선택창에서 텍스트상자 개체에 부여된 '이름'으로 해당 필드명(카테고리)를 찾아가는 방식이었습니다. 파워포인트에서는 도형의 이름으로 찾아가는 것이 쉽기 때문입니다.

​

이번에는 아래한글 메일머지 방식처럼 텍스트상자 내부에 "{{필드명}}" 과 같은 문구를 찾아서 글자를 바꾸는 방식으로 시도해보았습니다. 각자 장단점이 있습니다.

 

'{필드명}'보다는 '{(필드명}}' 으로 해야 혹시라도 중괄호를 사용하는 문구가 바뀌는 것을 방지할 수 있겠습니다.

​

1. 엑셀파일에는 명단 목록과 로고이미지가 들어 있습니다.

제일 첫번째 행이 필드(카테고리)명인데 첫번째 전체 연번과 필드명이 비어 있는 열은 제외합니다.

회색부분 최대 12열(L열)까지의 데이터를 넣을 수 있습니다. 로고가 없다면 무한대의 열을 사용할 수 있습니다.

​

2. 파워포인트 기준 슬라이드입니다. 맨 마지막 슬라이드가 됩니다.

텍스트상자 내부에 {{반}} 이나 {{이름}}과 같이 필드(카테고리)명과 같은 내용의 문구가 들어있어야 합니다.

먼저 발견된 도형부터 텍스트가 채워지므로 순서에 유의하세요.

여기서는 그룹으로 묶어서 그룹1~그룹8까지입니다. 한 페이지에 8명씩입니다.

로고는 [[로고]]로 문구를 표시하면 인식하고 해당 도형의 중앙에 맞춰서 엑셀에 있는 로고를 복사해서 삽입합니다.

[[로고]]문구는 사라지고 숨김처리됩니다.

작업 후 이 슬라이드는 숨김 처리되고 인쇄에서 제외됩니다.

​

3. 파워포인트의 VBA코드입니다.

'//[※ copyrightⓒ konahn 2024]

Option Explicit

Sub GeneratePPT()

    'On Error GoTo Done:
    
    Dim pres As Presentation
    Set pres = ActivePresentation
    Dim sld As Slide
    Dim shp As Shape, tshp As Shape, lshp1 As Object, lshp2 As Shape
    Dim p As Integer, q As Integer
    
    Dim XLapp As Object 'Excel.Application
    Set XLapp = CreateObject("Excel.Application")
    Dim book As Object  'Excel.Workbook
    Dim sht As Object   'Excel.Worksheet
    Dim rng As Object   'Excel.Range
    Dim LastRow As Long, LastCol As Long, c As Long
    Dim TargetXLS As String, TargetPPT As String
    Dim Category As String
    
    '엑셀 파일 선택 상자
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "엑셀목록", "*.xls?"
        If .Show = -1 Then TargetXLS = .SelectedItems(1)
    End With
    If Len(TargetXLS) = 0 Then GoTo Done:
    Set book = XLapp.Workbooks.Open(FileName:=TargetXLS, ReadOnly:=True)
    Set sht = book.ActiveSheet
    
    'A열 맨 아래행 구하기
    LastRow = sht.Cells(sht.Rows.Count, "A").End(-4162).Row       'xlUp(-4162)
    '1행 맨 오른쪽 셀 구하기
    'LastCol = sht.Cells(1, sht.Columns.Count).End(-4159).Column 'xlToLeft(-4159)
    LastCol = 12    '12열(L열)까지(회색 영역)
    
    '2행부터 모든 행에 대해 슬라이드 생성
    For Each rng In sht.Range("A2:A" & LastRow)
        
        '1,2,3,4,5,6,7,8 반복
        p = (rng.Row - 2) Mod 8 + 1   ' 한 슬라이드에서 8명씩
        If p = 1 Then
            '마지막 슬라이드를 복제
            Set sld = pres.Slides(pres.Slides.Count).Duplicate(1)
            '마지막 바로 앞으로 보내기
            sld.MoveTo pres.Slides.Count - 1
        End If
'Debug.Print p
        For c = 2 To LastCol    '2열부터 마지막 열까지(연번은 생략)
            Category = sht.Cells(1, c).Text

            If Category <> "" Then    '반, 이름 등 카테고리 제목이 있으면
                '각 컬럼 별로 해당 그룹도형 내부의 카테고리명의 텍스트상자에 입력
                'sld.Shapes("그룹 " & p).GroupItems(Category).TextFrame.TextRange.Text = _
                    rng.Offset(, c - 1).Text
'Debug.Print Category
                '{{카테고리}}를 찾아 해당값으로 교체(텍스트개체 순서대로)
                Set tshp = findShape(sld, "{{" & Category & "}}")
                If Not tshp Is Nothing Then
'Debug.Print tshp.ParentGroup.Name, tshp.Name
                    tshp.TextFrame.TextRange.Replace "{{" & Category & "}}", rng.Offset(, c - 1).Text
                End If
            End If
        Next c
        
        '로고 추가
        Set tshp = findShape(sld, "[[" & "로고" & "]]")
            If Not tshp Is Nothing Then
                If lshp1 Is Nothing Then
                    Set lshp1 = sht.Shapes("로고"):
                    lshp1.Copy: DoEvents
                End If
                Set lshp2 = sld.Shapes.Paste(1): DoEvents
                lshp2.Left = tshp.Left + tshp.Width / 2 - lshp1.Width / 2
                lshp2.Top = tshp.Top + tshp.Height / 2 - lshp1.Height / 2
                lshp2.Name = lshp2.Name & p
                tshp.TextFrame.TextRange.Replace "[[" & "로고" & "]]", ""
                tshp.Visible = msoFalse
            End If
        '슬라이드 감추기는 취소
        sld.SlideShowTransition.Hidden = False
        
    Next rng
    
    '기본 슬라이드는 슬라이드쇼에서 감춤
    pres.Slides(pres.Slides.Count).SlideShowTransition.Hidden = msoTrue
    '숨겨진 슬라이드 인쇄 안함
    pres.PrintOptions.PrintHiddenSlides = msoFalse
    
    '파일명 변경 저장
    'TargetPPT = pres.FullName
    'TargetPPT = Left(TargetPPT, InStrRev(TargetPPT, ".") - 1) & _
        "_자동생성" & (LastRow - 1) & ".pptx"
    'PPTfile.SaveAs FileName:=TargetPPT
Done:
    If Err Then MsgBox Err.Description
    If Not XLapp Is Nothing Then XLapp.Quit:    Set XLapp = Nothing
     
End Sub

'{{카테고리}}를 포함하는 도형 검색
Function findShape(oSld, sStr) As Shape
    Dim oShp As Shape, gShp As Shape
    
    For Each oShp In oSld.Shapes
        Set findShape = findInShape(oShp, sStr)
        If Not findShape Is Nothing Then Exit Function
    Next oShp
End Function

'{{카테고리}}를 포함하는지 검사
Function findInShape(fShp, sStr) As Shape
    Dim gShp As Shape
    If fShp.Type = msoGroup Then
            For Each gShp In fShp.GroupItems
                Set findInShape = findInShape(gShp, sStr)
                If Not findInShape Is Nothing Then Exit Function
            Next gShp
    Else
        If fShp.HasTextFrame Then
            If fShp.TextFrame.HasText Then
                If InStr(fShp.TextFrame.TextRange.Text, sStr) > 0 Then
                     Set findInShape = fShp
                End If
            End If
        End If
    End If
End Function

[[로고]] 그림을 삽입하고 대상 도형도 {{필드명/카테고리명}} 으로 찾아가는 방식이라 코드가 더 길어졌습니다.

​

4. 실행 결과

​

5. 첨부파일 참고하세요.

​

이렇게 '{{필드명}}' 방식으로 문구를 삽입하면 초보자도 문구가 슬라이드에 들어갈 위치를 지정하기 쉽습니다. 대신 순서에 주의해야 합니다. Alt+F10 창에서 아래쪽에 있을 수록 먼저 채워지게 됩니다.

 

도형을 그룹으로 묶어도 되고 묶지 않아도 됩니다. 그룹으로 묶으면 구분이 용이합니다.

 

단점은 마지막 페이지에 필요없는 {{이름}} 과 같은 문구가 남고 텍스트상자의 순서에 주의해야한다는 점입니다.

​

 

명찰리스트.xlsx

0.01MB

명찰양식1.pptm

0.06MB

 

 

참고: 지식인

참고: 한/글에서 메일 머지 결과를 라벨로 인쇄하기