• 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.

factuurnummer + opslaan

Status
Niet open voor verdere reacties.
of sluit en heropen het bestand:
Code:
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
 
@ Troedeboer
Daar zie ik eerlijk gezegd het nut niet van in. Dat mag je toch eens nader verklaren.
 
Als ik dit stuk code bij mij test, wordt het bestand gesloten en opnieuw geopend, wat TS graag wou
 
@turk1453 Vraag verwijderd. Graag een eigen vraag maken. Het is niet toegestaan in iemand anders zijn vraag jouw probleem te plaatsen. Dit is onoverzichtelijk voor de helpers maar vooral voor de topicstarter. Bovendien reageer je in een topic van meer dan drie maanden oud.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan