在将文件另存为.pdf之前询问存储文件的位置

时间:2016-06-26 11:13:34

标签: vba excel-vba excel

我有以下代码可以将某个选项打印到.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

一切正常。但是,由于我还想在其他计算机上实现它,我希望函数在保存之前询问保存文件的位置。

有人可以告诉我是否可以更改下面的代码,以便它可以弹出文件屏幕,以便我决定在哪里保存文件?

3 个答案:

答案 0 :(得分:0)

您需要GetSaveAsFilename对象的Application方法。它将显示“另存为”对话框并返回一个字符串。你这样使用它:

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 ...

的行

答案 1 :(得分:0)

试试这个:

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

在代码中添加了一行。

答案 2 :(得分:0)

考虑:

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