ファイルを保存する場所を.pdfとして保存するかどうかを確認する

Question

特定の選択肢を.pdfファイルに印刷するためのコードを以下に示します。

Sub printIt() 

     Dim input_value As String 
     Dim file_name As String 
     Dim Time As Date 

     input_value = InputBox("Please state the name of the sheet") 
     Time = TimeValue("9:20:01") 
     MsgBox (Time) 
     file_name = "C:\Users\Marc\Desktop\" + input_value + ".pdf" 

     Worksheets("end_screen").PageSetup.PrintArea = "$B$2:$D$27" 
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
     file_name, Quality:=xlQualityStandard, _ 
     IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ 
     True 

End Sub 

これはすべて問題なく動作します。しかし、他のコンピュータにも実装したいので、ファイルを保存する前にファイルを保存する場所を尋ねる機能が必要です。

ファイルを保存する場所を決めるために、ファイルの画面をポップアップできるように、以下のコードを変更することができるかどうかは誰にでも分かりますか？

Answer 1

ApplicationオブジェクトのGetSaveAsFilenameメソッドが必要です。 [名前を付けて保存]ダイアログが表示され、文字列が返されます。あなたはこのようにそれを使用します。

Option Explicit 

Sub Test() 

    Dim strOutFile As String 

    strOutFile = Application.GetSaveAsFilename(_ 
           InitialFileName:="export", _ 
           FileFilter:="PDF Files (*.pdf), *.pdf", _ 
           Title:="Save PDF as") 

    'strOutFile will be False if user hit Escape etc 
    If CBool(strOutFile) = False Then 
     ' user exits 
     Exit Sub 
    Else 
     ' do save 
     '... 
    End If 

End Sub 

'...のコメントがある。この例では - あなたはActiveSheet.ExportAsFixedFormat ...

Answer 2

のためのあなたのラインが含まれるであろう、これを試してみてください：

Sub printIt() 

    Dim input_value As String 
    Dim file_name As String 
    Dim Time As Date 

    input_value = InputBox("Please state the name of the sheet") 
    Time = TimeValue("9:20:01") 
    MsgBox (Time) 
    file_name = "C:\Users\Marc\Desktop\" + input_value + ".pdf" 

    myFile = Application.GetSaveAsFilename _ 
    (InitialFileName:=file_name, _ 
     FileFilter:="PDF Files (*.pdf), *.pdf", _ 
     Title:="Select Folder and FileName to save") 

    Worksheets("end_screen").PageSetup.PrintArea = "$B$2:$D$27" 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
    myFile, Quality:=xlQualityStandard, _ 
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ 
    True 

End Sub 

コード内で1行を追加しました。

Answer 3

は考えてみましょう：

Sub printIt() 

     Dim input_value As String 
     Dim file_name As String 
     Dim Time As Date, fldr As String 

     input_value = InputBox("Please state the name of the sheet") 
     Time = TimeValue("9:20:01") 
     MsgBox (Time) 
     fldr = GetFolder() & "\" 
     file_name = fldr & input_value & ".pdf" 

     Worksheets("end_screen").PageSetup.PrintArea = "$B$2:$D$27" 
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
     file_name, Quality:=xlQualityStandard, _ 
     IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ 
     True 

End Sub 

Function GetFolder() As String 
    Dim fldr As FileDialog 
    Dim sItem As String 
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker) 
    With fldr 
     .Title = "Select a Folder" 
     .AllowMultiSelect = False 
     .InitialFileName = Application.DefaultFilePath 
     If .Show <> -1 Then GoTo NextCode 
     sItem = .SelectedItems(1) 
    End With 
NextCode: 
    GetFolder = sItem 
    Set fldr = Nothing 
End Function