Сохраните еще один лист в формате pdf, пока цикл выйдет из выпадающего меню, не показывая поле «сохранить как» для каждого элемента.

Question

У меня есть это выпадающее меню на листе 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