Hi, have the following code which Ive modified which loops through a data validation cell and prints every iteration. At the moment everytime the data validation box changes, the sheet is printed to a PDF and a pop up box is called asking for the user to select the folder (which defaults to the location where the Xlsm is). Is there a way to automatically print to this location without the user needed to press ok. I have to press OK about 100 times for each loop of the validation...
Any help would be greatly appreciated.... i havent coded for a while and im very rusty.
Thanks
Sub Loop_Through_List()
Dim cell As Excel.Range
Dim rgDV As Excel.Range
Dim DV_Cell As Excel.Range
Set DV_Cell = Range("D2")
Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
For Each cell In rgDV.Cells
DV_Cell.Value = cell.Value
Call PDFActiveSheet
Next
End Sub
Sub PDFActiveSheet()
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("D3").Value & " " & ws.Range("D2").Value
sFolder = GetFolder()
If sFolder = "" Then
MsgBox "No folder selected. Code will terminate."
Exit Sub
End If
myFile = sFolder & "" & strFile
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
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
Any help would be greatly appreciated.... i havent coded for a while and im very rusty.
Thanks
Sub Loop_Through_List()
Dim cell As Excel.Range
Dim rgDV As Excel.Range
Dim DV_Cell As Excel.Range
Set DV_Cell = Range("D2")
Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
For Each cell In rgDV.Cells
DV_Cell.Value = cell.Value
Call PDFActiveSheet
Next
End Sub
Sub PDFActiveSheet()
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("D3").Value & " " & ws.Range("D2").Value
sFolder = GetFolder()
If sFolder = "" Then
MsgBox "No folder selected. Code will terminate."
Exit Sub
End If
myFile = sFolder & "" & strFile
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
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