매크로/모듈(Module)

시트의 선택영역을 지정 폴더에 PDF 출판

고추탄 2026. 1. 27. 21:35

Sub Publish_Range_To_Pdf()

 '★★시트의 선택영역을 PDF 출판★★

 'PDF FILE 저장 POLDER 지정
  Dim strPolderName As String
 '확장자를 포함한 워크북명
  Dim LATUS As String
 '확장자를 제거한 워크북명
  Dim strFileName As String
  Dim iSplit As Integer
  Dim sht As Worksheet
  Dim vAry() As Integer
  Dim ShtAry() As String
  Dim i As Integer
  Dim n As Integer
  Dim rng As Range
  Dim targetSht As Worksheet
  Dim PrintAreaRng As Range
  
  Set targetSht = ActiveSheet
  
  If targetSht.PageSetup.PrintArea = "" Then
     GoTo daum1
  Else
     Set PrintAreaRng = targetSht.Range(targetSht.PageSetup.PrintArea)
  End If
  
  
 '현재 선택된 영역 가져오기
  Set rng = Selection
  
  
 '선택 영역을 인쇄 영역으로 설정
  rng.Worksheet.PageSetup.PrintArea = rng.Address
  
  
 'PDF 출판 폴더를 지정
  With Application.FileDialog(msoFileDialogFolderPicker)
                                                       .Title = "PDF 저장 폴더를 선택하세요"
                                                       .Show
                                                    If .SelectedItems.Count = 0 Then Exit Sub
                                       strPolderName = .SelectedItems(1)
  End With
  
         
 '지정 폴더를 열기
  Shell "rundll32.exe url.dll,FileProtocolHandler " & strPolderName, vbNormalFocus
  
  
  LATUS = ActiveWorkbook.Name
  
 '확장자를 제거한 워크북명(filename)
  strFileName = ""
  iSplit = InStrRev(LATUS, ".")
  
  If iSplit = 0 Then
     strFileName = LATUS
  Else
     strFileName = Left(LATUS, iSplit - 1)
  End If
  
  i = 0
  
 '선택된 시트를 배열에 저장
  For Each sht In ActiveWindow.SelectedSheets
         
     i = i + 1
         
     ReDim Preserve vAry(1 To i)
     ReDim Preserve ShtAry(1 To i)
        
     vAry(i) = sht.Index
     ShtAry(i) = sht.Name
     
  Next
  
  
 '선택된 시트를 순환하면서 PDF 출판
  For n = LBound(ShtAry) To UBound(ShtAry) Step 1
  
      Sheets(ShtAry(n)).Select
  
     'PDF저장                                           'PDF저장폴더          '워크북             '순번                          '시트명
      rng.ExportAsFixedFormat Type:=xlTypePDF, FileName:=strPolderName & "\" & strFileName & " " & Format(vAry(n), "000") & " " & ShtAry(n) & "_" & Format(Now, "yyyymmdd_hhnnss") & ".pdf"
  
  Next
  
 '인쇄영역을 원래대로 재설정
  ActiveSheet.PageSetup.PrintArea = PrintAreaRng.Address

daum1:

 'MsgBox "지정시트의 선택영역을 PDF로 저장 되었습니다."
 
End Sub

Publish_Range_To_Pdf.txt
0.00MB

LIST