[엑셀연동] 봉투 주소 일괄 출력

관련: 지식인

 

엑셀 파워포인트 연동 작업은 서로 상호작용하는 부분을 염두에 두어야 하고 일괄 처리 후 결과 확인 및 코드 수정하는 과정이 있어서 시간이 좀 걸리는 작업입니다.

하지만 누군가 한 번 만들어 두면 다음에 사용하거나 다른 사람이 일처리할 때 빠르고 편리하게 이용할 수 있습니다.

​

 

엑셀 연동하는 기존 코드를 수정해서 작업했지만 그래도 시간이 걸렸습니다.

​

1. 일단 첨부한 봉투1_목록.xlsx 파일처럼 보내는 사람과 받는 사람의 목록을 작성하고 저장합니다.

 

주의) 엑셀 제목행의 컬럼 이름과 슬라이드의 도형이름이 정확히 일치해야 합니다.

F열 다음에 다른 컬럼을 추가해서 추가 문구를 표시할 수도 있습니다.

또한 이번 경우는 같은 행으로 처리할 텍스트 도형이름(주소, 우편번호)은 뒤에 언더바(_)를 붙여주세요.

그러면 윗행보다 여백(10pt)을 두고 아래로 내려줍니다.

​

2. 봉투1.pptm 파일의 파일속성에서 '차단해제' 체크/확인 후 열어서 매크로를 허용합니다.

​

3. 숨겨진 마지막 1슬라이드가 기준이 되므로 이 슬라이드에서 텍스트상자의 폰트, 글자크기, 색상, 도형의 위치, 정렬 등을 수정 편집합니다.

​

4. Alt-F8 로 GeneratePPT 매크로를 실행합니다.

5. 방금 작성한, 목록이 들어 있는 엑셀파일을 선택합니다.

​

6. 일괄로 목록 개수만큼 슬라이드가 자동 생성됩니다.

​

7. 완성 및 출력(숨겨진 슬라이드 인쇄에 체크 해제)

​

이번에는 엑셀이 아니라 파워포인트에서 매크로 코드를 추가했습니다.

'//[※ 변변치 않지만 코드에 대한 저작권은 작성자인 konahn에게 있습니다. copyrightⓒ konahn 2023]

Option Explicit

Const LineMargin As Single = 10 '행 간격

Sub GeneratePPT()

    On Error GoTo Done:
    
    Dim pres As Presentation
    Set pres = ActivePresentation
    Dim sld As Slide
    Dim shp As Shape
    
    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 uTop As Single
    
    '엑셀 파일 선택 상자
    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, 1).End(-4162).Row       'xlUp(-4162)
    '1행 맨 오른쪽 셀 구하기
    LastCol = sht.Cells(1, sht.Columns.Count).End(-4159).Column 'xlToLeft(-4159)
    
    '모든 행에 대해 슬라이드 생성
    For Each rng In sht.Range("a2:a" & LastRow)
        
        '마지막 슬라이드를 복제
        Set sld = pres.Slides(pres.Slides.Count).Duplicate(1)
        '마지막 바로 앞으로 보내기
        sld.MoveTo pres.Slides.Count - 1
        
        For c = 1 To LastCol
            '각 컬럼 별로 입력
            sld.Shapes(sht.Cells(1, c).Text).TextFrame.TextRange.Text = _
                rng.Offset(, c - 1).Value
            
            '주소와 우편번호의 경우 바로 위 도형의 높이에 따라 아래로 이동시킴
            If c Mod 3 = 0 Or c Mod 3 = 2 Then
                With sld.Shapes(sht.Cells(1, c - 1).Text)
                    uTop = .Top + .Height + LineMargin
                End With
                sld.Shapes(sht.Cells(1, c).Text).Top = uTop
                sld.Shapes(sht.Cells(1, c).Text & "_").Top = uTop
            End If
        Next c
        '슬라이드 감추기는 취소
        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

 

[※ 변변치 않지만 위 코드에 대한 저작권은 작성자인 저 konahn에게 있습니다. copyright© konahn 2023]

​​

특히 이번에는 받는 사람 아래의 주소나 우편번호의 경우 바로 위의 텍스트가 길어서 아래로 내려오는 만큼 아래 도형도 내려가도록 조절해 보았습니다. 현재 기본 행간 여백은 10pt입니다. (현재는 받는사람, 주소, 우편번호 이렇게 3개씩 반복되어야 합니다.)

​

인쇄할 때는 모든 슬라이드 인쇄를 누르고 숨겨진 슬라이드 인쇄에 체크를 해제되었는지 확인하세요.

(매크로 실행하면 자동으로 해제됨)

 

 

매크로와 샘플 파일 첨부합니다.

pptm 매크로파일은 항상 다운로드 후 파일속성에서 차단해제해 주세요.

 

봉투1_목록.xlsx

0.01MB

봉투1.pptm

0.04MB