Bekijk de onderstaande video om te zien hoe je onze site als een web app op je startscherm installeert.
Opmerking: Deze functie is mogelijk niet beschikbaar in sommige browsers.
Privacywetgeving
Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.
Option Explicit
Const MijnPad = "C:\Facturen\" 'directory waar de facturen staan
Sub tst()
Dim Nr As Integer, Pad As String, c1 As String, x As String, Naam As String, i As Integer
Dim Omschr As String
Omschr = "F" & Year(Date) & "-" 'zoek naar factuurnrs van het huidige jaar
Pad = MijnPad & IIf(Right(MijnPad, 1) <> "\", "\", "")
c1 = Dir(Pad & Omschr & "*.pdf*") 'zoek xls-files (en xlsm,xlsx, ...) die beginnen met bovenstaande omschrijving
Do Until c1 = "" 'zoeken tot je alle files langsgelopen hebt
x = Replace(c1, Omschr, "") 'verwijder omschrijving
i = InStr(1, x, ".pdf") 'nu nog de file-extensie
If i > 0 Then x = Left(x, i - 1)
If IsNumeric(x) Then 'is wat overblijft nog numeric
Nr = WorksheetFunction.Max(Nr, CInt(x)) 'zoek hoogste nummer tot nogtoe
End If
c1 = Dir
Loop
Naam = Omschr & Format(Nr + 1, "000") 'naam van de factuur (voor het geval je max. 999 facturen per jaar maakt
[f4].Value = Naam
Call Save_as_pdf(Pad & Naam & ".pdf")
'Workbooks.Open Filename:=(Pad & "factuursjabloon.xlsm")
Call Reopen
End Sub
Sub Save_as_pdf(sNewFilePath As String)
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sNewFilePath, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
Private Sub Reopen()
Application.OnTime Now, "Reopen2"
ThisWorkbook.Close False
End Sub
Private Sub Reopen2()
ThisWorkbook.Activate
End Sub
We gebruiken essentiële cookies om deze site te laten werken, en optionele cookies om de ervaring te verbeteren.