엑셀 파일 pdf로 저장 문의드려요

Question

Option Explicit

Sub PDF_Save()
Dim WS As Worksheet
Set WS = ActiveSheet

Dim FileName As String
Dim FilePONO As String
Dim FileNameVendor As String
FileNameVendor = WS.Range("B3") & "발주관련_" & Format(Date, "yymmdd")

Dim WSH As Object
Set WSH = CreateObject("WScript.Shell")

Application.ScreenUpdating = False

With ActiveSheet.PageSetup
.PaperSize = xlPaperA4
.Orientation = xlPortrait
.FitToPagesTall = 1
.FitToPagesWide = 1
End With
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=WSH.SpecialFolders("Desktop") & "\" & FileNameVendor & " " & FilePONO & ".pdf", _
OpenAfterPublish:=False
ActiveSheet.Select
Application.ScreenUpdating = True

End Sub

바탕화면에 발주관련 pdf 파일 생성은 잘됨

같은 파일로 여러번 pdf로 저장하고 싶은데 한개의 파일로만 저장되요

예를들어 발주서 1 / 발주서 2 이렇게 pdf로 저장하고 싶습니다.

도와주세요

더블유에이 · Answer

fPath = FileSequence(WSH.SpecialFolders("Desktop") & "\" & FileNameVendor & " " & FilePONO & ".pdf")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=fPath, _
OpenAfterPublish:=False
ActiveSheet.Select
Application.ScreenUpdating = True

로 바꾸면 되겠습니다.

아래 보조함수 추가하시고요..

https://www.oppadu.com/vba-filesequence-%ed%95%a8%ec%88%98/

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ FileSequence 함수
'▶ 기존 파일이 존재할 경우 순번을 매겨 파일을 저장합니다.
'▶ 인수 설명
'_____________FilePath : 확장자를 포함한 파일 경로입니다.
'_____________Sequence : 순번을 매길 시작번호입니다.
'_____________Delimiter : 파일명과 순번을 구분할 구분자입니다.
'▶ 보조 명령문 안내 : FileExist 함수
'###############################################################

Private Function FileSequence(FilePath As String, Optional Sequence As Long = 1, Optional Delimiter As String = "-") As String

Dim Ext As String: Dim Path As String: Dim newPath As String
Dim Pnt As Long

Pnt = InStrRev(FilePath, ".")
Path = Left(FilePath, Pnt - 1)
Ext = Right(FilePath, Len(FilePath) - Pnt + 1)

newPath = Path & Delimiter & Sequence & Ext

Do Until FileExists(newPath) = False
Sequence = Sequence + 1
newPath = Path & Delimiter & Sequence & Ext
Loop

FileSequence = newPath

End Function

더블유에이 · Answer

Sub PDF_Save()
Dim WS As Worksheet
Set WS = ActiveSheet

Dim FileName As String
Dim FilePONO As String
Dim FileNameVendor As String
FileNameVendor = WS.Range("B3") & "발주관련_" & Format(Date, "yymmdd")

Dim WSH As Object
Set WSH = CreateObject("WScript.Shell")

Application.ScreenUpdating = False

With ActiveSheet.PageSetup
.PaperSize = xlPaperA4
.Orientation = xlPortrait
.FitToPagesTall = 1
.FitToPagesWide = 1
End With

Dim fPath As String

fPath = FileSequence(WSH.SpecialFolders("Desktop") & "\" & FileNameVendor & " " & FilePONO & ".pdf")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=fPath, _
OpenAfterPublish:=False
ActiveSheet.Select
Application.ScreenUpdating = True

End Sub

Private Function FileSequence(FilePath As String, Optional Sequence As Long = 1, Optional Delimiter As String = "-") As String

Dim Ext As String: Dim Path As String: Dim newPath As String
Dim Pnt As Long

Pnt = InStrRev(FilePath, ".")
Path = Left(FilePath, Pnt - 1)
Ext = Right(FilePath, Len(FilePath) - Pnt + 1)

newPath = Path & Delimiter & Sequence & Ext

Do Until FileExists(newPath) = False
Sequence = Sequence + 1
newPath = Path & Delimiter & Sequence & Ext
Loop

FileSequence = newPath

End Function

Public Function FileExists(ByVal path_ As String) As Boolean
 
'########################################################
'입력한 파일경로에 파일 존재여부를 확인합니다.
'https://www.oppadu.com/vba-fileexists-함수/
'########################################################
 
    FileExists = (Dir(path_, vbDirectory) <> "")
 
End Function

한번 확인해보세요