Factuurnummer verhogen & opslaan middels een knop

[JDR001]

Voor het maken van facturen ben ik op zoek naar een macro.
Ik wil een knop hebben voor het opslaan & genereren van een uniek factuurnummer.
Ik heb op de verschillende forums gezocht, maar deze genereren (dus verhoging van factuurnummer) bij het openen van het bestand. Dit wil ik niet omdat er door meerdere personen factuurnummers worden gegenereert en ik het nummer wil genereren als de factuur helemaal is ingevult en dan met een knop een factuurnummer genereer + het bestand onder die factuurnummer wordt opgeslagen. Dus wil ik dat als ik op de knop klik, excel gaat zoeken in de map; facturen en hier het hoogste factuurnr uitzoekt. Deze kan dan vervolgens verhoogd worden dus bv. hoogste factuurnr=005 het nieuwe factuurnr. wordt dan 006. Vervolgens wordt deze waarde, dus 006 in een cel gezet. Daarna kan excel het bestand opslaan met de waarde in die cel.
Heeft iemand hier een oplossing voor.
Alvast bedankt.

 

[HSV]

Zo zou het kunnen.

Je bestaande factuur heb ik even voor het gemak 'Origineel factuur' genoemd.
Deze heb ik in de map 'Facturen' gezet waar de facturen met oplopend nummer ook worden opgeslagen.

Zelf even juiste directions aanpassen.

Sub tst()


Set fs = Application.FileSearch
With fs
    .LookIn = "D:\Facturen"
    .Filename = "0*"
    If .Execute > 0 Then
        MsgBox "Het factuurnummer is " & Format(.FoundFiles.Count + 1, "000")
        For i = 1 To .FoundFiles.Count
            Next i
        Range("A1") = i
      Range("A1").NumberFormat = "000"
    Else
     MsgBox "Het factuurnummer is " & Format(1, "000")
        Range("A1") = 1
     Range("A1").NumberFormat = "000"
    End If
End With
 ThisWorkbook.SaveAs "D:\Facturen\" & Format(Sheets("Blad1").Range("A1").Value, "000") & ".xls"
     Workbooks.Open ("D:\Facturen\Origineel factuur.xls")
   ThisWorkbook.Close
End Sub

 

[JDR001]

Dank voor je reactie.
Ik krijg een fout melding op de regel:
Set fs = Application.FileSearch
deze wordt geel.

Weet iemand hier een oplossing voor.

 

[danny147]

Beste JDROO1,

Dank voor je reactie.
Ik krijg een fout melding op de regel:
Set fs = Application.FileSearch
deze wordt geel.

Weet iemand hier een oplossing voor.

Zorg dat je een map aangemaakt hebt die Facturen heet op de D schijf.
Heb je dit niet (D schijf) dan moet je de code aanpassen.

Groetjes Danny. :thumb:

 

[JDR001]

Ik heb een map aangemaakt met facturen op de d schijf. Ik heb nog even op google gekeken, maar ik denk dat het niet ondersteund wordt door MS excel 2007. Weet iemand een code die wel ondersteund wordt door MS Excel 2007.
dankje

 

[danny147]

Beste JDR001

Inderdaad, Application.FileSearch wordt niet ondersteund door MS excel 2007

Kijk hier eens

Was ook niet vermeld in je openingstopic dat je werkt met Excel 2007

Groetjes Danny. :thumb:

 

[JDR001]

Klopt had het in het begin topic moeten vermelden.
Ik snap niet hoe ik nu precies het in de code moet veranderen.
Moet ik alleen het deel tot: If .Execute > 0 Then veranderen?

 

[Warme bakkertje]

Sub tst()
    x = 0
    c1 = Dir("D:\Facturen\*")
    Do Until c1 = ""
        x = x + 1
        c1 = Dir
    Loop
    With [Blad1!A1]
        .Value = IIf(x > 0, x + 1, 1)
        .NumberFormat = "000"
    End With
    ThisWorkbook.SaveAs "D:\Facturen\" & Format(Sheets("Blad1").Range("A1").Value, "000") & ".xls"
    Workbooks.Open ("D:\Facturen\Origineel factuur.xls")
    ThisWorkbook.Close
End Sub

 

[cow18]

een lichte aanpassing aan jouw bijdrage, zodat factuurnummers doe vaak een omschrijving staan hebben voor het nummer ook behandeld kunnen worden. Bovendien wordt in je map ook effectief gekeken naar de facturen die daar staan en daarvan wordt de grootste opgezocht. Misschien staan niet alle of meer facturen in die map.

Option Explicit
Const Omschr = "F2011-"                                    'tekst waarmee factuurnummer begint
Const MijnPad = "D:\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
  Pad = MijnPad & IIf(Right(MijnPad, 1) <> "\", "\", "")
  c1 = Dir(Pad & Omschr & "*.xls*")                        '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, ".xls")                                '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
  [Blad1!A1].Value = Naam
  ThisWorkbook.SaveAs Pad & Naam & ".xls"
  Workbooks.Open (Pad & "Origineel factuur.xls")
  ThisWorkbook.Close
End Sub

 

[Warme bakkertje]

@ cow18
Mooi :thumb:, en als we dan toch bezig zijn kunnen we de omschrijving ook 'universeler' maken zodat je niet elk jaar je macro moet aanpassen, maar automatisch naar het juiste jaartal gezocht wordt.

Option Explicit
Const MijnPad = "D:\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
 [COLOR="red"] Dim Omschr As String
  Omschr = "F" & Year(Date) & "-"                          'zoek naar factuurnrs van het huidige jaar[/COLOR]
  Pad = MijnPad & IIf(Right(MijnPad, 1) <> "\", "\", "")
  c1 = Dir(Pad & Omschr & "*.xls*")                        '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, ".xls")                                '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
  [Blad1!A1].Value = Naam
  ThisWorkbook.SaveAs Pad & Naam & ".xls"
  Workbooks.Open (Pad & "Origineel factuur.xls")
  ThisWorkbook.Close
End Sub

 

[cow18]

@ Warm Bakkertje, ook OK, 't is nu te hopen dat TS's werkjaar niet loopt van bv 1 april to 31 maart.

 

[JDR001]

bedankt ik heb het helemaal werkend.

 

[basvandoremalen]

verkorte macro

Hoi mensen,
Ik heb excel 2010. Mijn vraag is een simpelere versie van de eerste vraag, ik zoek een macro die ik kan hangen onder een knop welke een factuurnummer ophoogt als ik erop druk.
Hoor graag of iemand iets heeft

Bas

 

[Warme bakkertje]

Bas, gelieve hierover zelf een topic te beginnen waarin je duidelijk je probleem voorlegt.
Zoals jij het voorsteld lijkt het mij een beetje te eenvoudig.

Sub tst()
  [A1].value = [A1].value + 1
End Sub

Dit is dan ook het simpelste antwoord dat gegeven kan worden.

 

[rolhul01]

Hoe kan ik mijn "factuur" opslaan als PDF

Beste cow18,

Bedankt voor je bijdrage, erg handig!

Maar ik wil het bestand graag opslaan als PDF, weet jij/iemand hoe ik dit kan aanpassen?

Wanneer ik een macro-tje opneem en ik plak dit er tussen dan kom ik er niet uit...

Alvast bedankt,
Rolf

 

[Warme bakkertje]

Rolf, inbreken in iemands vraag is niet netjes. Start zelf een nieuwe vraag met eventueel een verwijzing naar dit topic.
In antwoord op je vraag, als je XL2007 hebt moet je in de VBA-help eens kijken bij ExportAsFixedFormat anders zal je een extern programma moeten aanspreken.