选择PDF文件保存的位置

时间:2015-04-15 01:03:32

标签: excel vba excel-vba pdf

我很放心,我终于得到了以下代码,以便在这个社区的帮助下工作。

我的心愿单上还有一个选项,我正在努力奋斗。目前,下面的代码将工作表3一直保存到标题为" post"作为单独的PDF文件到我选择的文件夹。这是由形状触发的。

我试图让下面的代码提示选择一个文件夹,以便用户可以选择保存PDF文件的位置,是否有人有任何想法如何执行此操作?

此外,底部的Call Shell最好打开保存文件的文件夹,但只要用户知道文件的保存位置,就不一定需要这样做:)

Sub SaveAllPDF()
Dim i As Integer
Dim Fname As String
Dim TabCount As Long


TabCount = Sheets("Post").Index
'Set the TabCount to the last cell you want to PDF

' Begin the loop.

For i = 3 To TabCount
'Set i = the number of the first sheet you want to PDF in order from left to right To TabCount
    If Sheets(i).Visible <> xlSheetVisible Then
    Else
        With Sheets(i)
            Fname = .Range("C15") & " " & .Range("E13") & "-" & .Range("B1")
            'The Fname above is equaling the cells that the PDF's filename will be
            'The folder directory below is where the PDF files will be saved
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\Brandon\Desktop\operation automated\RLtemp\" & Fname, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        End With
    End If
Next i

Call Shell("explorer.exe" & " " & "C:\Users\Brandon\Desktop\operation automated\RLtemp\", vbNormalFocus)
'This opens the folder where the PDFs are saved
End Sub

1 个答案:

答案 0 :(得分:1)

您可以使用Excel的FileDialog对象:

Sub SaveAllPDF()
    Dim i As Integer
    Dim Fname As String
    Dim TabCount As Long

    TabCount = Sheets("Post").index
    'Set the TabCount to the last cell you want to PDF

    Dim dialog As FileDialog
    Dim path As String

    Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
    dialog.AllowMultiSelect = False
    If dialog.Show = -1 Then
        path = dialog.SelectedItems(1)
        ' Begin the loop.
        For i = 3 To TabCount
        'Set i = the number of the first sheet you want to PDF in order from left to right To TabCount
            If Sheets(i).Visible <> xlSheetVisible Then
            Else
                With Sheets(i)
                    Fname = .Range("C15") & " " & .Range("E13") & "-" & .Range("B1")
                    'The Fname above is equaling the cells that the PDF's filename will be
                    'The folder directory below is where the PDF files will be saved
                    .ExportAsFixedFormat Type:=xlTypePDF, filename:=path & "\" & Fname, Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                End With
            End If
        Next i

        Call Shell("explorer.exe" & " " & path & "\", vbNormalFocus)
        'This opens the folder where the PDFs are saved
    End If
End Sub