Question

我在Sheet 9上有这个下拉菜单，我需要宏来遍历单元格E5下拉列表中的所有项目，并将Sheet10的副本保存为pdf，下拉列表中的项目引用了每个不同的信息。我不想将其保存为每个文档，因此最好有一个代码可以根据单元格E5中写入的内容将特定文件夹中的所有文档保存为不同的名称。（这个过程每个月都会发生，所以如果每个月可以将所有文档保存在不同的文件夹中会很好）。到目前为止，我有一个代码，只保存表10，但我还没有弄清楚循环。有没有人有代码可以做到这一点？：）

Answer 1

我不确定，但我认为当E5更改时它会自动更改Sheet10上的数据，因此Sheet1o对于Sheet1.range（“E5”）下拉列表中选择的每个项目都会有所不同。如果是这样，那么这将有效。如果没有，它至少会告诉你如何为当月创建一个新文件夹，并将sheet10作为pdf文件保存到该文件夹。

    Sub testDir()

    Dim mnth As String
    Dim yr As String
    Dim dateString As String
    Dim pathToDir As String
    Dim myFolder As String
    Dim myFile As String
    Dim totalElements
    Dim element As Range
    Dim wb As Workbook
    Dim activeSh As Worksheet
    Dim aWB As Worksheet


    Set activeSh = Sheets("Sheet9")
    activeSh.Activate
    Set aWB = Sheets("Sheet10")

    '   set up folder and path for current month
    pathToDir = "C:\Temp\"
    mnth = Left(MonthName(Month(Date)), 3)
    yr = Year(Date)
    dateString = yr & "_" & mnth
    myFolder = pathToDir & dateString

    If Not ifFolderExists(myFolder) Then
        ' Folder for current month does not exist yet
        ' Create folder "C:\Temp\2017_Feb" or whatever current year and month is
        Beep
        MkDir myFolder
    End If

    '   Get  items from dropdown list
    Set totalElements = Evaluate(Range("E5").Validation.Formula1)

    '   This is where I'm fuzzy -
    '   If when you select each item, does that automatically change data on Sheet10?
    '   If so, do this

    For Each element In totalElements
       if element.name <> "" then            
        Sheet1.Range("E5").Value = element
        myFile = myFolder & "\" & "_" & element & ".pdf"
        ChDir myFolder
        aWB.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            myFile, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
            False
       End if
    Next element

    End Sub


Public Function ifFolderExists(folderPath As String) As Boolean
    On Error Resume Next
    ifFolderExists = (GetAttr(folderPath) And vbDirectory) = vbDirectory
    On Error GoTo 0
End Function

将另一个工作表另存为pdf，同时循环显示下拉列表，而不显示每个项目的“另存为”框

1 个答案: