L oop через список проверки и печать pdf в папку, определенную ячейкой

Question

Я использовал ответ на аналогичный вопрос, чтобы получить vba ниже. Этот сценарий vba работает, когда путь к папке жестко запрограммирован, но я надеюсь, что папка для распечатанного файла PDF будет определяться ячейкой («G7»).

Sub Loop_Through_List()
    
    Sheets("Report Template").Select
    Range("B5").Select
    
    Dim ws                    As Worksheet
    Dim cell                  As Excel.Range
    Dim rgDV                  As Excel.Range
    Dim DV_Cell               As Excel.Range
    Dim folderPath            As String

    folderPath = GetFolder(Range("G7").Value)
    'folderPath = GetFolder()

    Set DV_Cell = Range("B5")

    Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
    For Each cell In rgDV.Cells
        DV_Cell.Value = cell.Value
        PDFActiveSheet folderPath
    Next
    
    Sheets("Notes").Select
    Range("A1").Select
End Sub

Sub PDFActiveSheet(Optional ByVal folderPath As String = "")
    Dim ws                    As Worksheet
    Dim myFile                As Variant
    Dim strFile               As String
    Dim sFolder               As String
    On Error GoTo errHandler

    Set ws = ActiveSheet

    'enter name and select folder for file
    ' start in current workbook folder
    strFile = ws.Range("B5").Value

    If folderPath = "" Then
        '--- if no folder path is specified, then default to
        '    the same path as the active workbook
        folderPath = ActiveWorkbook.Path
        If Len(folderPath) = 0 Then
            '--- to force Excel to have a path (instead of no
            '    path at all), use the current directory
            '    notation
            folderPath = "."
        End If
    End If
    myFile = folderPath & "\" & strFile

    ws.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False, _
            From:=1, _
            To:=2

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

Function GetFolder() As String
    Dim dlg                   As FileDialog
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    dlg.InitialFileName = ThisWorkbook.Path & "\"
    dlg.Title = "Select folder to save PDFs"
    If dlg.Show = -1 Then
        GetFolder = dlg.SelectedItems(1)
    End If
End Function

Answer 1

Мне удалось заставить его работать с помощью Майка. В конце концов, я использовал ActiveWorkbook.Path & "", чтобы определить путь к папке. Я не знаю, является ли какой-либо код избыточным, но он работает для того, что мне нужно. Большое спасибо.

Sub Loop_Through_List()
    
    Sheets("Report Template").Select
    Range("B5").Select
    
    Dim ws                    As Worksheet
    Dim cell                  As Excel.Range
    Dim rgDV                  As Excel.Range
    Dim DV_Cell               As Excel.Range
    Dim folderPath            As String
    Dim Path            As String

    folderPath = ActiveWorkbook.Path & "\"
    'folderPath = GetFolder()

    Set DV_Cell = Range("B5")

    Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
    For Each cell In rgDV.Cells
        DV_Cell.Value = cell.Value
        PDFActiveSheet folderPath
    Next
    
    Sheets("Notes").Select
    Range("A1").Select
End Sub

Sub PDFActiveSheet(Optional ByVal folderPath As String = "")
    Dim ws                    As Worksheet
    Dim myFile                As Variant
    Dim strFile               As String
    Dim sFolder               As String
    On Error GoTo errHandler

    Set ws = ActiveSheet

    'enter name and select folder for file
    ' start in current workbook folder
    strFile = ws.Range("B5").Value

    If folderPath = "" Then
        '--- if no folder path is specified, then default to
        '    the same path as the active workbook
        folderPath = ActiveWorkbook.Path
        If Len(folderPath) = 0 Then
            '--- to force Excel to have a path (instead of no
            '    path at all), use the current directory
            '    notation
            folderPath = "."
        End If
    End If
    myFile = folderPath & "\" & strFile
    ws.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False, _
            From:=1, _
            To:=2

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

Function GetFolder() As String
    Dim dlg                   As FileDialog
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    dlg.InitialFileName = ThisWorkbook.Path & "\"
    dlg.Title = "Select folder to save PDFs"
    If dlg.Show = -1 Then
        GetFolder = dlg.SelectedItems(1)
    End If
End Function

Answer 2

Если имя папки уже находится в ячейке G7, вам не нужна функция GetFolder:

Текущий код

folderPath = GetFolder(Range("G7").Value)

Заменить на:

folderPath = Range("G7").Value