Sub MRL_Selectie() 'voorbeelden: 'https://www.wallstreetmojo.com/vba-variable-range/ 'variabelen maken 'voor de teller Dim vCount As Variant 'De view couter Dim xScreen As Boolean Dim I As Long 'Start LInput: vCount = Sheets("Printen").Range("c8").Value If TypeName(vCount) = "Boolean" Then Exit Sub 'Controle op fouten If (vCount = "") Or (Not IsNumeric(vCount)) Or (vCount < 1) Then MsgBox "Ergens gaat iets fout, neem contact op met Mathijs", vbInformation, "Oeps" GoTo LInput Else 'Werkblad berekenen Application.Calculate xScreen = Application.ScreenUpdating Application.ScreenUpdating = False For I = Sheets("Printen").Range("c7").Value To vCount Sheets("Printen").Range("c6").Value = I Call MRL_PDF_MAKER 'ActiveSheet.PrintOut Next 'ActiveSheet.Range("c6").ClearContents Application.ScreenUpdating = xScreen End If Worksheets("Printen").Activate End Sub Sub MRL_PDF_MAKER() Dim sh As Worksheet Dim FileName As String Dim printview As Range Dim vanx As Integer Dim vany As Integer Dim totx As Integer Dim toty As Integer Dim rngx As Integer Dim rngy As Integer If ActiveWindow.SelectedSheets.Count > 1 Then MsgBox "There is more then one sheet selected," & vbNewLine & _ "ungroup the sheets and try the macro again" Else 'Werkblad berekenen Application.Calculate 'variabelen waarden geven vanx = Sheets("Printen").Range("d2").Value vany = Sheets("Printen").Range("e2").Value totx = Sheets("Printen").Range("d3").Value toty = Sheets("Printen").Range("e3").Value 'waarde controleren 'NTB 'berekenenvam: 'tussenwaarde's rngx = totx - vanx + 1 rngy = toty - vany + 1 Worksheets("Planning").Activate 'de printview rng instellen Set printview = Cells(vany, vanx).Resize(rngy, rngx) 'de printview selecteren printview.Select 'Call the function with the correct arguments 'For a fixed range use this line FileName = MRL_Create_PDF(Source:=Selection, _ FixedFilePathName:=Sheets("Printen").Range("C9").Value _ & Sheets("Printen").Range("C10").Value _ & Sheets("Printen").Range("C11").Value & ".pdf", _ OverwriteIfFileExist:=True, _ OpenPDFAfterPublish:=True) 'For the selection use Selection in the Source argument 'FileName = MRL_Create_PDF(Source:=Selection) 'For a fixed file name use this in the FixedFilePathName argument 'FixedFilePathName:="C:\Users\Ron\Test\YourPdfFile.pdf" If FileName <> "" Then 'Ok, you find the PDF where you saved it 'You can call the mail macro here if you want Else MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _ "Microsoft Add-in is not installed" & vbNewLine & _ "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _ "The path to Save the file in arg 2 is not correct" & vbNewLine & _ "You didn't want to overwrite the existing PDF if it exist" End If End If End Sub Function MRL_Create_PDF(Source As Object, FixedFilePathName As String, _ OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String Dim FileFormatstr As String Dim Fname As Variant If FixedFilePathName = "" Then 'Open the GetSaveAsFilename dialog to enter a file name for the pdf FileFormatstr = "PDF Files (*.pdf), *.pdf" Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _ Title:="Create PDF") 'If you cancel this dialog Exit the function If Fname = False Then Exit Function Else Fname = FixedFilePathName End If 'If OverwriteIfFileExist = False we test if the PDF 'already exist in the folder and Exit the function if that is True If OverwriteIfFileExist = False Then If Dir(Fname) <> "" Then Exit Function End If 'Now the file name is correct we Publish to PDF On Error Resume Next Source.ExportAsFixedFormat _ Type:=xlTypePDF, _ FileName:=Fname, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=OpenPDFAfterPublish On Error GoTo 0 'If Publish is Ok the function will return the file name If Dir(Fname) <> "" Then RDB_Create_PDF = Fname End Function