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

katanka

Gebruiker
Lid geworden
20 sep 2009
Berichten
20
Ik experimenteer met volgende code uit dit topic:

Code: 
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
  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 & "*.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

Ik heb hierbij 2 vraagjes.
1. Wanneer ik zo'n factuur open in 2O1O krijg ik de mededeling dat het bestand niet de indeling heeft die overeenkomt met de extensie. Na een klik op OK kan ik wel gewoon verder.

2. Hoe kan ik opslaan als PDF ipv als XLS?

Bedankt!
 
voor punt 2 moet je gebruik maken van de ActiveSheet:
Code: 
Sub Save_as_pdf(sNewFilePath As String)
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=sNewFilePath, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
 
ben echt een nietsweter hoor, waar moet ik dat stukje code inplakken?
hartelijk bedankt
 
je hebt in het huidige stuk al een Sub tst() staan.
bij deze code plak je het tweede stukje code wat ik heb neergezet.
In plaats van de ThisWorkbook.SaveAs Pad & Naam & ".xls" kun je dan call Save_as_pdf(Pad & Naam & ".pdf") aanroepen.
 
ik zou zo denken:
Code: 
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
  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 & "*.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
  Call Save_as_pdf(Pad & Naam & ".pdf")
  Workbooks.Open (Pad & "Origineel factuur.xls")
  ThisWorkbook.Close
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
 
bijna. Ik heb nu het onderstaande, alleen werkt de automatische nummering van de opgeslagen bestanden nu niet meer. Hij overschrijft altijd hetzelfde bestand ipv door te tellen. Ik ben dus op zoek naar de oude functionaliteit (automatisch factuurnummer in de bestandsnaam en in de factuur), maar dan gewoon met PDF ipv xls.

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 & "*.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
  [f4].Value = Naam
  Call Save_as_pdf(Pad & Naam & ".pdf")
  Workbooks.Open (Pad & "factuursjabloon.xlsm")
  ThisWorkbook.Close
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
 
Wijzig overal waar xls staat naar pdf
 
Bedankt allebei, nu werkt het inderdaad. Nog 1 lastig probleempje wel, Excel crasht wanneer hij op het einde van de macro (nadat hij mededeling toont dat factuurjabloon.xslm al geopend is en dat opnieuw openen alle wijzigingen ongedaan zal maken) het bestand factuursjabloon opnieuw opent.
 
Als het al open is, waarom open je het dan opnieuw in je macro ????
 
om het leeg te maken? zodat ik een nieuwe factuur kan starten en niet per ongeluk de gegevens inschrijf in de originele
 
Als het al open is moet je het toch maar gewoon activeren dan ipv terug openen
 
en wat wordt de code dan? Zoals gezegd weet ik er echt heel weinig van :confused: Merci
 
Kijk eens bij Activate.
 
als ik het volgende doe (heb er een activitate tussen gezwierd), crasht excel niet meer, maar natuurlijk worden mijn factuur ook niet automatisch terug gereset naar de starttoestand.
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")
  ThisWorkbook.Activate
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

Kan ik dan misschien beter een aparte module maken + knop om de factuur terug te wissen? Welke code heb ik daarvoor nodig?
 
Laatst bewerkt:
Maar je factuurbestand blijft toch altijd het actieve bestand, aangezien dit niet echt een sjabloon is in de ware zin v/h woord. Als je in je macro Save_as_pdf OpenAfterPublish op False zet blijft je factuur toch actief en kan je in je tst-macro na de Call-procedure gewoon de gewenste bereiken wissen.
 
ja, dat wil ik. Maarrrr, hoe roep ik de functie aan om bereiken te wissen?
 
bv.
Code: 
Range("A5:A10").Clearcontents
Plaats er eventueel nog de bladnaam voor om zeker te zijn dat de velden op het juiste werkblad gewist worden.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan