VBA code voor fakturen automatisch nummeren en opslaan

[oeldere]

Beste forumgebruikers,

Ja, ik weet dat er een zoekfunctie op dit forum is, maar helaas kan ik het gewenste resultaat niet vinden. en Ja, ik weet dat dit al verschillende malen aan bod is geweest.

MS heeft een verkoopfactuur5 met code, maar ik ben niet bekend met VBA en vraag dus toch maar hulp.

van bijgevoegde faktuur wens ik:

1) in j5 automatische ophoging van het faktuurnummer

2) automatisch opslaan van de factuur:

2a) Z:\fakturen\
2b) met faktuurnummer (J5) en naam (C7)

samengevat dus:
Z:\fakturen\faktuurnummer naam

Wie wil me hier bij helpen?

alvast hartelijk dan voor de hulp.

Met vriendelijke groeten,

Oeldere

 

[Hoornvan]

Heb je hier al gekeken?

 

[HSV]

Ik was er al eventjes mee bezig, maar omdat ik er weinig kaas van gegeten heb duurt het wat langer om het uit te vogelen.
Dan toch maar plaatsen lijkt me.
Om ook maar een stapje te maken in VBA.

Misschien lijkt dit er een beetje op Oeldere.
Eventjes cel $D$1 aanpassen.

 

[oeldere]

alvast bedankt , ga er vanavond mee aan de slag.

kom er dan nog even op terug.

 

[HSV]

Ik kom er ook even op terug Oeldere,

Ik ben dus ook maar een amateur op dit gebied, en zag dat de factuur steeds één slag in het achteren kwam. :shocked:
Bijgaand een nieuwe versie.

 

[oeldere]

1e eigen vba code

Ben tot onderstaand gekomen (zie bijlage)

Sub Opslaan()
Range("j5").Value = Range("j5").Value + 1
ActiveWorkbook.SaveAs FileName:= _
"Z:\test\" & _
Sheets("Blad1").Range("j2") & _
Format(Sheets("Blad1").Range("j5"), "000") & " " & Sheets("Blad1").Range("j7") & ".xls"

End Sub

Wie heeft aanvullingen, opmerkingen, verbeteringen en wil deze met me delen.

 

[snb]

Andere insteek:

Maak een txt-bestandje met de naam:
"C:\20100001.txt"

Op het moment dat je de faktuur gaat opslaan:

Sub opslaan()
  c0=dir("C:\" & year(date) & "*.txt")
  c1=left(c0,8)+1

  Thisworkbook.sheets("Blad1").range("J5")=c1
  ThisWorkbook.SaveAs "C:\" & c1 & ".txt" 
  name "C:\" & c0 as "C:\" & c1 & ".txt"
Sub

 

[HSV]

Heb hier en daar wat aangepast.

Ps. bijlage verwijderd en nieuwe geplaatst i.v.m. afsluiten met kruisje.

 

[oeldere]

Beste SNB,

bedankt voor de reactie.

wat is het voordeel van een txt.bestand i.p.v. excel bestand?

 

[oeldere]

Beste Harry,

Private Sub Workbook_Open()

    Range("J5").Value = Range("B1").Value
    Range("B1").Value = Range("B1").Value
    Range("J7").Value = Date
   
 End Sub

wat doet bovenstaande code extra?

 

[oeldere]

Ben tot onderstaand gekomen (zie bijlage)

Sub Opslaan()
Range("j5").Value = Range("j5").Value + 1
ActiveWorkbook.SaveAs FileName:= _
"Z:\test\" & _
Sheets("Blad1").Range("j2") & _
Format(Sheets("Blad1").Range("j5"), "000") & " " & Sheets("Blad1").Range("j7") & ".xls"

End Sub

Wie heeft aanvullingen, opmerkingen, verbeteringen en wil deze met me delen.

Bovenstaande code zal waarschijnlijk niet gaan werken, als je het bestandje als sjabloon (template) gaat gebruiken.

welke code dien ik dan nog bij te voegen?

 

[snb]

Het wordt niet beinvloed door wat je met Excel doet.
Je kunt het niet per ongeluk verwijderen als je een bestand bewerkt (en wel als je het gewoon in een Excel-werkblad zet)
Je hoeft het niet te openen om de naam ervan te kunnen lezen of wijzigen.
Diverse gebruikers kunnen er conflictloos tegelijkertijd gebruik van maken, vanuit Excel, Word of willekeurig ander programma.
Het is veel sneller.
De VBA-code is veel simpeler.
En zo kunnen we nog wel een tijdje doorgaan.

 

[oeldere]

Beste SNB,

dat is duidelijk dan.
code zal worden omgezet naar txt file.

zeer bedankt voor de toelichting.

 

[snb]

Het hoeft niet eens een txt.bestand te zijn:
Je maakt het eenvoudig (fast as lighting) met:

Sub tst4()
  Open "C:\20100001" For Output As #1
  Close #1
End Sub

de opslaan-macro wordt dan:

Sub opslaan()
  c0=dir("C:\" & year(date) & "*")
  name "C:\" & c0 as "C:\" & c0 +1

  With Thisworkbook
     .sheets("Blad1").range("J5")=c0+1
     .SaveAs "E:\fakturen\faktuur_" & c0+1 & ".xls" 
  End With
Sub

 

[HSV]

Beste Harry,

Private Sub Workbook_Open()

    Range("J5").Value = Range("B1").Value
    [COLOR="Red"]Range("B1").Value = Range("B1").Value[/COLOR]
    Range("J7").Value = Date
   
 End Sub

wat doet bovenstaande code extra?

De rode regel kan weg Oeldere,

Bij het opslaan met de knop verhoog je het factuurnummer, en opgeslagen onder dat factuurnummer.
Ik heb de codes gesplitst omdat, als je met het kruisje ging afsluiten de factuur ook werd opgeslagen, en bij een volgende opening het factuurnummer niet synchroon liep.
Er stond eerst nog een +1 achter, na die te hebben weggelaten liep de nummering correct met het laatst opgeslagen bestand.

Maar zoals ik al vermelde, ik ben geen VBA exceller.
@snb kan het ook vast nog beter verwoorden.

 

[oeldere]

bedankt

Ik ga hier eerst nog eens zelf mee aan de slag.

Waarschijnlijk zullen hier dan nog wel vragen over komen.

Alle collega's hartelijk bedankt voor het meedenken en de aangedragen oplossingen.

Ik sluit de topic nu (anders blijft ie veel te lang openstaan).

 

[tvkijker]

automatisch factuurnummeren door auteur SNB

Hallo ,
Ik zou graag dit draadje weer openen. Het was voor mij de aanzet tot automatisch nummerenvan facturen, maar ik heb een paar problemen vooral met plaatsing. Ik krijg namelijk de foutcode dat er een vervolg verwacht wordt , maar ik weet met die opmerking niet goed raad. Ik wil door met de codes en txt fils van SNB , maar waar plaats ik deze codes? Ik heb ze nu eenvoudig als macro onder een opslag plaats gehangen, maar dan kreeg ik eerder genoemde error. M.a.w. Hoe initieer ik deze codes in mijn sheet (met een knop ?) of moet het anders ? En wat is dan tst (4) ook een knop ?

Groeten,
Dirk


Sub tst4()
Open "C:\20100001" For Output As #1
Close #1
End Sub
de opslaan-macro wordt dan:
Code:
Sub opslaan()
c0=dir("C:\" & year(date) & "*")
name "C:\" & c0 as "C:\" & c0 +1

With Thisworkbook
.sheets("Blad1").range("J5")=c0+1
.SaveAs "E:\fakturen\faktuur_" & c0+1 & ".xls"
End With
Sub