diff --git a/Excel-VBA/variabele selectie PDF maker b/Excel-VBA/variabele selectie PDF maker new file mode 100644 index 0000000..7abbb0e --- /dev/null +++ b/Excel-VBA/variabele selectie PDF maker @@ -0,0 +1,148 @@ +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 \ No newline at end of file