VBA 인쇄하여 PDF 파일로 저장하고 자동 파일 이름으로 저장

Question

워크 시트의 선택된 영역을 PDF으로 인쇄하고 사용자가 폴더와 입력 파일 이름을 선택할 수 있도록하는 코드가 있습니다.

1. 이는 PDF 파일이 특정 세포를 기반으로 파일 이름으로 파일을 사용자의 바탕 화면에 폴더를 생성하고 저장할 수있는 방법이 있나요 :

   내가 생각하고 싶은 두 가지가 있습니다 시트?

2. 동일한 시트의 여러 복사본을 PDF로 저장/인쇄 할 경우 각 복사본에 숫자가있을 수 있습니다. ? 카피 수에 따라 파일 이름에 2, 3 ** 여기

내가 지금까지 가지고있는 코드 :

Sub PrintRentalForm() 
Dim filename As String 

Worksheets("Rental").Activate 


filename = Application.GetSaveAsFilename(InitialFileName:="", _ 
            FileFilter:="PDF Files (*.pdf), *.pdf", _ 
            Title:="Select Path and Filename to save") 

If filename <> "False" Then 
With ActiveWorkbook 
    .Worksheets("Rental").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _ 
               filename:=filename, _ 
               Quality:=xlQualityStandard, _ 
               IncludeDocProperties:=True, _ 
               IgnorePrintAreas:=False, _ 
               OpenAfterPublish:=True 
End With 
End If 


filename = Application.GetSaveAsFilename(InitialFileName:="", _ 
            FileFilter:="PDF Files (*.pdf), *.pdf", _ 
            Title:="Select Path and Filename to save") 

If filename <> "False" Then 
With ActiveWorkbook 
    .Worksheets("RentalCalcs").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _ 
               filename:=filename, _ 
               Quality:=xlQualityStandard, _ 
               IncludeDocProperties:=True, _ 
               IgnorePrintAreas:=False, _ 
               OpenAfterPublish:=False 
End With 
End If 

End Sub` 

업데이트 : 코드 및 참조를 변경하고 지금은 작동 . 나는 렌탈 시트의 명령 버튼에 코드를 연결했다. -

Private Sub CommandButton1_Click() 
Dim filenamerental As String 
Dim filenamerentalcalcs As String 
Dim x As Integer 


x = Range("C12").Value 
Range("C12").Value = x + 1 

Worksheets("Rental").Activate 

Path = CreateObject("WScript.Shell").specialfolders("Desktop") 

filenamerental = Path & "\" & Sheets("Rental").Range("O1") 

'ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select 
Worksheets("Rental").Range("A1:N24").Select 
Selection.ExportAsFixedFormat _ 
    Type:=xlTypePDF, _ 
    Filename:=filenamerental, _ 
    Quality:=xlQualityStandard, _ 
    IncludeDocProperties:=True, _ 
    IgnorePrintAreas:=False, _ 
    OpenAfterPublish:=False 

Worksheets("RentalCalcs").Activate 

Path = CreateObject("WScript.Shell").specialfolders("Desktop") 

filenamerentalcalcs = Path & "\" & Sheets("RentalCalcs").Range("O1") 

'ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select 
Worksheets("RentalCalcs").Range("A1:N24").Select 
Selection.ExportAsFixedFormat _ 
    Type:=xlTypePDF, _ 
    Filename:=filenamerentalcalcs, _ 
    Quality:=xlQualityStandard, _ 
    IncludeDocProperties:=True, _ 
    IgnorePrintAreas:=False, _ 
    OpenAfterPublish:=False 

Worksheets("Rental").Activate 
Range("D4:E4").Select 

End Sub 

Answer 1

바라기를 이것은 자명하다. 코드의 주석을 사용하여 현재 상황을 이해할 수 있습니다. 단일 셀을이 함수에 전달하십시오. 해당 셀의 값이 기본 파일 이름이됩니다. 셀에 "AwesomeData"가 포함되어 있으면 현재 사용자 데스크탑에서 AwesomeData.pdf라는 파일을 만들 것입니다. 이미 존재하는 경우 AwesomeData2.pdf 등을 시도하십시오. 당신의 코드에서 당신은 당신이 코드를 단계별로해야 할 경우 무슨 일이 일어나고 있는지 알아내는 데 도움이됩니다 filename = GetFileName(Range("A1"))

Function GetFileName(rngNamedCell As Range) As String 
    Dim strSaveDirectory As String: strSaveDirectory = "" 
    Dim strFileName As String: strFileName = "" 
    Dim strTestPath As String: strTestPath = "" 
    Dim strFileBaseName As String: strFileBaseName = "" 
    Dim strFilePath As String: strFilePath = "" 
    Dim intFileCounterIndex As Integer: intFileCounterIndex = 1 

    ' Get the users desktop directory. 
    strSaveDirectory = Environ("USERPROFILE") & "\Desktop\" 
    Debug.Print "Saving to: " & strSaveDirectory 

    ' Base file name 
    strFileBaseName = Trim(rngNamedCell.Value) 
    Debug.Print "File Name will contain: " & strFileBaseName 

    ' Loop until we find a free file number 
    Do 
     If intFileCounterIndex > 1 Then 
      ' Build test path base on current counter exists. 
      strTestPath = strSaveDirectory & strFileBaseName & Trim(Str(intFileCounterIndex)) & ".pdf" 
     Else 
      ' Build test path base just on base name to see if it exists. 
      strTestPath = strSaveDirectory & strFileBaseName & ".pdf" 
     End If 

     If (Dir(strTestPath) = "") Then 
      ' This file path does not currently exist. Use that. 
      strFileName = strTestPath 
     Else 
      ' Increase the counter as we have not found a free file yet. 
      intFileCounterIndex = intFileCounterIndex + 1 
     End If 

    Loop Until strFileName <> "" 

    ' Found useable filename 
    Debug.Print "Free file name: " & strFileName 
    GetFileName = strFileName 

End Function 

디버그 라인으로 라인을 filename = Application.....를 대체 할 수있다. 잘 보이도록 제거하십시오. 나는 변수들에 조금 미쳤지 만, 이것을 가능한 한 명확하게 만들어야했다. 액션에서

O1은 따옴표없이 문자열 "파일 이름"을 포함

내 세포. 이 하위 함수를 사용하여 함수를 호출하고 파일을 저장했습니다.

Sub Testing() 
    Dim filename As String: filename = GetFileName(Range("o1")) 

    ActiveWorkbook.Worksheets("Sheet1").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _ 
               filename:=filename, _ 
               Quality:=xlQualityStandard, _ 
               IncludeDocProperties:=True, _ 
               IgnorePrintAreas:=False, _ 
               OpenAfterPublish:=False 
End Sub 

귀하의 코드는 다른 모든 부분과 관련하여 어디에 있습니까? 기존 코드를 아직 가지고 있지 않은 경우 모듈을 만들어야합니다.