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
'매크로 > 모듈(Module)' 카테고리의 다른 글
| 지정 폴더의 파일명에 붙어 있는 "KakaoTalk_"삭제하고 싶어요 (0) | 2026.02.09 |
|---|---|
| 시트를 순환하며 선택영역을 지정폴더에 JPG 출판(Ⅱ) (0) | 2026.01.28 |
| 시트를 순환하며 선택영역을 지정폴더에 JPG 출판(Ⅰ) (0) | 2026.01.22 |
| VBA에서 워크북을 열 때 네트워크 프린터 연결 때문에 지연 (0) | 2025.08.22 |
| 입력 모드를 영문(알파벳)으로 설정 (1) | 2025.05.09 |