Avatar billede N00b Novice
03. maj 2005 - 05:20 Der er 43 kommentarer og
2 løsninger

Automatisk nummer

Jeg har lavet en simpel faktura skabelon i excel, men jeg kan ikke findeud af hvordan jeg får min skabelon, til at autogenerere et nyt fortløbende faktura nummer, for vergang jeg starter skabelonen op.

Kan det lade sig gøre, og hvis det kan hvordan.

skabelonen findes her http.//rex.homeftp.org/Fak.XLT
Avatar billede N00b Novice
03. maj 2005 - 05:21 #1
EDIT: Ups
skabelonen findes her http://rex.homeftp.org/Fak.XLT
virker måske bedre
Avatar billede sjap Praktikant
03. maj 2005 - 09:15 #2
Det kan det sikkert godt. Men hvor har du tænkt dig at skabelonen skal finde det sidste nummer? Man skal jo have et sted at starte.
Avatar billede sjap Praktikant
03. maj 2005 - 09:31 #3
På selve fanebladet "Faktura" højreklikker du og vælger "Vis programkode".
I venstre side af skærmbilledet dobbeltklikker du så på "ThisWorkBook", og i det hvide område indsætter du nedenstående.

Private Sub Workbook_Open()

Worksheets("Faktura").Range("H13") = Worksheets("Faktura").Range("H13") + 1
ActiveWorkbook.Save
Do
    fName = Application.GetSaveAsFilename
Loop Until fName <> False
ActiveWorkbook.SaveAs FileName:=fName

End Sub

Når du åbner arket, vil programmet lægge en til fakturanummeret og gemme arket (så arket gemmet det nyeste fakturanummer).

Derefter laves en SaveAs (gem som) så du ikke gemmer den nye faktura oven i masteren. Det kan du selvfølgelig bare fjerne, hvis du ikke har brug for det.
Avatar billede N00b Novice
03. maj 2005 - 14:04 #4
Jeg kan ikke få det til at virke.
Jeg har lagt koden ind i skabelonen, og efter athavedeaktiveret macro sikkerheden, lavede jeg en hurtig test fak. Men der blev ikke oprettet +1 nogle steder.

Kan man få excel til at hente fak nr. fra bib. jeg havde tiltænkt at fak. sættes til at gemme i spec. bib.
Eller lave en lille fil der holder styr på fak nr. Og helt perf. hvis man kan få den til at gemme som fak nr eks. Fak0001.xls
Avatar billede sjap Praktikant
03. maj 2005 - 15:10 #5
Jeg forstår ikke lige hvorfor den ikke laver +1 - det gør den da her (i Celle H13 på faneblad "Faktura")

Nedenstående skulle ændre navnet:

Private Sub Workbook_Open()

Worksheets("Faktura").Range("H13") = Worksheets("Faktura").Range("H13") + 1
ActiveWorkbook.Save
ActiveWorkbook.SaveAs FileName:="Fak" & Format(Worksheets("Faktura").Range("H13"), "0000")

End Sub
Avatar billede N00b Novice
03. maj 2005 - 15:19 #6
Jeg gør måske noget forkert.
Jeg bruger samme fil, som jeg har lagt på server.
Jeg højre klikkede, og pastede koden.
Gemte skabelonen. klikkede på skabelonen, så den åbnede et nyt dokument udfyldte med fak. nr. mm. gemte som fak0001, startede igen skabelonen, men der intet sker :-(

Hvad gør jeg galt ?

Evt. hvis du vil sende den du har rettet til, så kan jeg måske se hvad jeg gør galt.

mail = jr@[mit brugernavn her på exp.].dk
Avatar billede sjap Praktikant
03. maj 2005 - 16:09 #7
Regneark sendt.
Avatar billede N00b Novice
03. maj 2005 - 16:24 #8
Takker.

Hmm. når jeg starter skabelonen førstegang, gemmer den 2 filer en fak1.xls og fak0001.xls, når jeg så starter skabelonen andengang spørger den om at over skrive begge filer :-(. Er det mig der gør nogetgalt, eller skal man ikke bruge skabelon, men fak1.xls.

Sidst men ikke mindst, kan jeg undgå at når jeg åbner en gemt fak. at den ligger +1 til fak. nummeret ? mere det er jo meget rart at kan kan gå baglæns i sine faktura og kigge uden at den opretter en ny fak.
Jeg tænker her om man kan lave det så det kun er Masteren der har macro og ikke selve fakturane ?
Avatar billede N00b Novice
03. maj 2005 - 16:30 #9
Jeg prøver at få macroen til at sætte 000 foran fak nr. men den her kode virker ikke :(
Worksheets("Faktura").Range("H13") = Worksheets("Faktura").Range("H13"), "000") + 1
Er der en anden måde at gøre det på ?
Avatar billede sjap Praktikant
03. maj 2005 - 17:05 #10
Har rodet lidt med det. Prøv at erstatte den nuværende kode med denne her:

Private Sub Workbook_Open()

Worksheets("Faktura").Range("H13") = Worksheets("Faktura").Range("H13") + 1

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:="Fak", FileFormat:=xlTemplate
Application.DisplayAlerts = True

StiNavn = "C:\Faktura\"
Filnavn = StiNavn & "Fak" & Format(Worksheets("Faktura").Range("H13"), "0000")
If Dir(Filnavn) = "" Then
    ActiveWorkbook.SaveAs FileName:=NytFilnavn, FileFormat:=xlNormal
Else
    MsgBox "Fakturanummer eksisterer allerede. Programmet afsluttes", vbCritical + vbOKOnly, "Kritisk fejl!"
    Application.Quit
End If

End Sub
Avatar billede sjap Praktikant
03. maj 2005 - 17:07 #11
Bemærk lige at i den sidste ændring skal du angive et StiNavn for hvor filerne skal placeres. Det bliver så kontrolleret om den nye fil findes. Hvis den gør lukkes programmet ned. Så kan man jo prøve igen - uanset denne fejl bliver fakturanummeret øget med 1 hver gang makroen kører.
Avatar billede N00b Novice
03. maj 2005 - 17:31 #12
Jeg får en runtime error 1004, den kan ikke hitte u'a mappen/filnavnet
Avatar billede sjap Praktikant
03. maj 2005 - 17:34 #13
UPS!

NytFilnavn ændres til Filnavn
Avatar billede sjap Praktikant
03. maj 2005 - 17:35 #14
Og så skal du lige sikre dig at stien angivet i StiNavn findes.
Avatar billede N00b Novice
03. maj 2005 - 17:38 #15
Det hjalp ;)
Kan få den til at "slette" makroen i xls filerne, så ikke at der bliver lagt +1 til når man åbner allerede skrevet fak's ?
Og hvordan får jeg passet det at der kommer til at stå 0001 i stedet for 1 i fak ner.

Beklager at jeg er så besværlig, men jeg fatter - af vb/macro
Avatar billede sjap Praktikant
03. maj 2005 - 17:40 #16
Der var lige en fejl i eksisterende fil -kontrollen. Så linien

If Dir(Filnavn) = "" Then

ændres til

If Dir(Filnavn & ".xls") = "" Then
Avatar billede sjap Praktikant
03. maj 2005 - 17:44 #17
Nedenstående skulle sørge for at alt det der kopiering og nummerering kun sker når Fak.xlt åbnes (hvis du bruger et andet navn, skal du lige huske at ændre det):

Private Sub Workbook_Open()

If ActiveWorkbook.Name = "Fak.xlt" Then
    Worksheets("Faktura").Range("H13") = Worksheets("Faktura").Range("H13") + 1

    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs FileName:="Fak", FileFormat:=xlTemplate
    Application.DisplayAlerts = True

    StiNavn = "C:\Faktura\"
    Filnavn = StiNavn & "Fak" & Format(Worksheets("Faktura").Range("H13"), "0000")
    If Dir(Filnavn & ".xls") = "" Then
        ActiveWorkbook.SaveAs FileName:=Filnavn, FileFormat:=xlNormal
    Else
        MsgBox "Fakturanummer eksisterer allerede. Programmet afsluttes", vbCritical + vbOKOnly, "Kritisk fejl!"
        Application.Quit
    End If
End If

End Sub
Avatar billede N00b Novice
03. maj 2005 - 17:53 #18
Hmm nu skriver den slet ikke fak nr/gemmer som fak0001 :(
Har jeg gjort noget galt?
Avatar billede N00b Novice
03. maj 2005 - 17:55 #19
Avatar billede sjap Praktikant
03. maj 2005 - 17:58 #20
Det er det gamle spøgelse "Fak1", der er dukket op igen. Jeg ved ikke lige hvor der kommer fra.

Prøv at ændre

If ActiveWorkbook.Name = "Fak.xlt" Then

til

If ActiveWorkbook.Name = "Fak1" Then
Avatar billede N00b Novice
03. maj 2005 - 18:04 #21
Nu kalder den bare næste fil fak11.xlt ???
Jeg har bare pasted koden her fra.
Kan du få det til at virke hos dig ?
Avatar billede sjap Praktikant
03. maj 2005 - 18:12 #22
Det problem får jeg ikke. Det virker fint her. Sender lige mit ark.
Avatar billede N00b Novice
03. maj 2005 - 18:46 #23
Yes mange mange mange takker, du fortjener en kold ØL.
Bare sig til og jeg sender dig 1-2 stks. humle som tak for hjælpen.

Har lige en lille ting ekstra.
Kan man lave sp der automatisk bliver indsat dags dato i dato feltet.
Samt indsat dagsdato + 15 i betales senest feltet.
Avatar billede sjap Praktikant
03. maj 2005 - 20:04 #24
Har lavet lidt ekstra kode, der indsætter

Aktuel dato i celle H12
Aktuel dato + 15 dage i celle H17

Husk at formatere cellerne til datoformat (H12 er p.t. formateret til tekst, og H17 skal du nok flette med I17 for at kunne se datoen).

Jeg har lavet en lille ekstra detalje, der sikrer, at "Betales senest" ikke falder på en lørdag eller søndag - der tages dog ikke højde for helligdage, det må du gøre manuelt.

Bare sig til, så mailer jeg mit ark.


Private Sub Workbook_Open()

If ActiveWorkbook.Name = "Fak1" Then
    Worksheets("Faktura").Range("H13") = Worksheets("Faktura").Range("H13") + 1

    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs FileName:="Fak", FileFormat:=xlTemplate
    Application.DisplayAlerts = True

    StiNavn = "C:\Faktura\"
    Filnavn = StiNavn & "Fak" & Format(Worksheets("Faktura").Range("H13"), "0000")
    If Dir(Filnavn & ".xls") = "" Then
        Worksheets("Faktura").Range("H12") = Date
        Worksheets("Faktura").Range("H17") = Date + 15 + IIf(WeekDay(Date + 15) = 1, 1, IIf(WeekDay(Date + 15, 2) = 7, 2, 0))
        ActiveWorkbook.SaveAs FileName:=Filnavn, FileFormat:=xlNormal
        Worksheets("Faktura").Range("H14").Select
    Else
        MsgBox "Fakturanummer " & Format(Worksheets("Faktura").Range("H13"), "0000") & " eksisterer allerede. Programmet afsluttes", vbCritical + vbOKOnly, "Kritisk fejl!"
        Application.Quit
    End If
End If

End Sub
Avatar billede N00b Novice
03. maj 2005 - 20:06 #25
Dammed det er bare lækkert, det her jeg har savnet den funktion i 100 år og en madpakke, og hvis du kan hekse den med datoen/betalings datoen også, jammen så er hele min måned redet :-)
Hvis du vil have flere point, så opretter jeg bare et nyt Q.
Avatar billede N00b Novice
03. maj 2005 - 20:08 #26
Du må meget gerne maile, for det virker ikke når jeg paster her fra. Jeg tror at der er kuk i min udklipsholder :(
Avatar billede sjap Praktikant
03. maj 2005 - 20:46 #27
Jeg har neglet en norsk funktion, der kan beregne om datoer er helligdage (fra http://www.erlandsendata.no/english/index.php?d=enfunctionsdateholidays). Jeg har fordansket funktionen lidt, og tilpasset On-Open makroen. Så nu skulle du også kunne undgå at angive en helligdag som sidste frist - Det er dog altid at kontrollere og ikke stole blindt på den slags - der kan jo have sneget sig en fejl ind.

Function ErHelligdag(testDato As Long, InclLørdage As Boolean, InclSøndage As Boolean) As Boolean
Dim InputYear As Integer, PD As Long, OK As Boolean
    If testDato <= 0 Then testDato = Date
    InputYear = Year(testDato)
    PD = Påskedag(InputYear)
    OK = True
    Select Case testDato
        Case DateSerial(InputYear, 1, 1) ' Nytårsdag
        Case PD - 7    ' Palmesøndag
        Case PD - 3    ' Skærtorsdag
        Case PD - 2    ' Langfredag
        Case PD        ' Påskedag
        Case PD + 1    ' 2. påskedag
        Case PD + 26    ' St. Bededag
        Case PD + 39    ' Kristi Himmelfartsdag
        Case PD + 49    ' Pinsedag
        Case PD + 50    ' 2. Pinsedag
        Case DateSerial(InputYear, 12, 24) ' Juleaftensdag
        Case DateSerial(InputYear, 12, 25) ' Juledag
        Case DateSerial(InputYear, 12, 26) ' 2. Juledag
        Case DateSerial(InputYear, 12, 31) ' Nytårsaftensdag
        Case Else
            OK = False
            If InclLørdage Then
                If WeekDay(testDato, vbMonday) = 6 Then
                    OK = True
                End If
            End If
            If InclSøndage Then
                If WeekDay(testDato, vbMonday) = 7 Then
                    OK = True
                End If
            End If
    End Select
    IsHoliday = OK
End Function

Function Påskedag(InputYear As Integer) As Long
Dim d As Integer
    d = (((255 - 11 * (InputYear Mod 19)) - 21) Mod 30) + 21
    Påskedag = DateSerial(InputYear, 3, 1) + d + (d > 48) + 6 - ((InputYear + InputYear \ 4 + d + (d > 48) + 1) Mod 7)
End Function
Avatar billede sjap Praktikant
03. maj 2005 - 20:48 #28
Sender lige arket så du ikke skal bøvle med kopieringen ;0)

Om du synes, der skal gives ekstra point vil jeg lade være op til dig. Jeg har jo fået de point du har stillet i udsigt, og så er jeg sådan set tilfreds.
Avatar billede N00b Novice
03. maj 2005 - 23:12 #29
Oki, jeg aner heller ikke hvordan jeg skal tilføje flere point, uden at skulle oprette et nyt Q.
Avatar billede chpe05 Nybegynder
01. juni 2006 - 20:39 #30
Du lyder til at være kanon flink, Sjap, kunne jeg ikke også få fakturaen. Jeg har bøvlet med koderne hér, men får de samme fejl! Chris.Sogaard@gmail.com
Avatar billede N00b Novice
02. juni 2006 - 01:03 #31
Fakturen kan stadig hentes på rex.homeftp.org/Fak1.xlt (har lige opdateret linket)

/Rex
Avatar billede chpe05 Nybegynder
02. juni 2006 - 10:59 #32
Det kan godt være at det er mig der er idiot, men fakturaen virker ikke hos mig. Den har de samme problemer som dem kancaie har været igennem. Jeg har tilladt makroer, en mappe på c:\faktura\ , osv osv, men den gennerer hverken et nyt nummer, eller en ny faktura. Jeg åbner kun skabelonen hver gang. Er jeg bara en analfabet eller ...?
Avatar billede chpe05 Nybegynder
02. juni 2006 - 11:31 #33
OK. Efter at have rodet lidt med det fik jeg den til at virke. Men nu har jeg jo genneret faktura 0522-0001. Næste gang jeg åbner skabelonen, siger den så at der allerede er en faktura med nummeret 0522-0001, og programmet afsluttes. Det skal den jo også gøre, men hvordan hulken får man så skabelonen til at lave det næste nummer? Gemmer man skabelonen for hver gang eller?
Avatar billede chpe05 Nybegynder
02. juni 2006 - 11:34 #34
Det er den her linie: ActiveWorkbook.SaveAs Filename:="Fak", FileFormat:=xlTemplate der skal gøre det, men hvorfor gør den ikke det?
Avatar billede sjap Praktikant
02. juni 2006 - 19:38 #35
Så vidt jeg husker, så gemmes templaten hver gang du åbner den. Det sker i sætningen

    ActiveWorkbook.SaveAs FileName:="Fak", FileFormat:=xlTemplate

og INDEN den gemmes, er fakturanummeret blevet opdateret.

Der er ikke nogen specifikation af hvor templaten skal gemmes, så den gemmes blot i den mappe du har åbnet sidst (fra Excel). Hvis du bruger menuen Filer/åbn i Excel, så er det den mappe som templaten ligger i, men hvis du f.eks. dobbeltklikker på templaten i Stifinder, så er det ikke sikkert, at det er den rigtige mappe.

Mit gæt er at du har en ekstra template liggende på din PC - formodentligt i mappen dokumenter - og denne template vil virke!
Avatar billede sjap Praktikant
02. juni 2006 - 19:40 #36
Hvis du vil sikre dig at templaten ligger et bestemt sted, kan du blot skrive hele stien i filnavnet.
Avatar billede N00b Novice
03. juni 2006 - 00:54 #37
Jeg tror at grunden til at fak. nummeret ikke bliver opdateret er at jeg har samlet H & I 12. Ikke at det er sikker at det er det

/Rex
Avatar billede chpe05 Nybegynder
03. juni 2006 - 09:28 #38
Du havde ret sjap, men det vidste du vel. Som Liz Hurley siger: Be Specific!
Avatar billede sjap Praktikant
03. juni 2006 - 10:18 #39
;0)
Avatar billede wan68647 Nybegynder
06. maj 2009 - 12:00 #40
Det er godt nok en gammel tråd men den har hjulpet mig en del, men nu sidder jeg sku fast...!

Jeg har lavet et excel ark som en "master" (xls-fil). Når jeg åbner arket, gemmer den som en ny og kalder arket for faktura 0002. Men når jeg åbner masteren igen, skriver den at faktura 0002 allerede eksistere. Dvs. den gemmer den ikke som en ny fil og kalder den 0003. Det gør den kun hvis jeg åbner faktura 0002.

Nogen der kan hitte ud hvad jeg gør forkert?

Her er min kode:

Private Sub Workbook_Open()

If ActiveWorkbook.Name = "Quotation_Fomular.xls" Then
    Worksheets("Motor Quotation").Range("B5") = Worksheets("Motor Quotation").Range("B5") + 1

    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="Quotation_", FileFormat:=xlNormal
    Application.DisplayAlerts = True

    StiNavn = "O:\02_A&D\AD_Kunder\g-h-i\Grundfos DK 8120747\Tilbud\Quotations\2009\"
    Filnavn = StiNavn & "Quotation_" & Format(Worksheets("Motor Quotation").Range("B5"), "0000")
    If Dir(Filnavn & ".xls") = "" Then
        ActiveWorkbook.SaveAs Filename:=Filnavn, FileFormat:=xlNormal
  Else
    MsgBox "Quotation does allready excist - Program terminated", vbCritical + vbOKOnly, "Kritisk fejl!"
    Application.Quit
    End If
End If

    With ActiveSheet
      .Protect Password:="ncj", UserInterfaceOnly:=True
      .EnableOutlining = True
    End With
   
End Sub
Avatar billede N00b Novice
06. maj 2009 - 15:36 #41
Lad mig gætte.
Du bruger office 2003 sp2 eller 3??

Har nemmelig fået samme prob, efter at have opdateret office pakken.

Jeg skiftede så til http://www.sigmaregnskab.dk der er et access baseret regnskabsprogram. det virker ganske fint og koster gratis.

/Rex
Avatar billede wan68647 Nybegynder
06. maj 2009 - 15:45 #42
Ja, men det har også virket under SP2 og vidst også SP3.

Jeg skal bruge det til tilbud og da det er arbejdsrelateret må jeg ikke installere fremsoftware på min firmapc.
Avatar billede N00b Novice
06. maj 2009 - 15:59 #43
Hmm så ved jeg ikke hvad der går galt for jeg oplevede efter at have opdateret office pakken...

Men jeg mener at have fak1.xlt ligende et eller andet sted hvis du vil have en kopi?

/Rex
Avatar billede wan68647 Nybegynder
07. maj 2009 - 08:52 #44
Men fik du rettet problemet så det virkede igen?
Avatar billede N00b Novice
11. maj 2009 - 18:01 #45
Hej
Nej den virker stadig ikke.

Men prøv at oprette et nyt Q. der må være nogle der ved hvorfor det ikke virker mere...

Det kunne jo også være en Xp opdatering der driller.

Beklager at jeg ikke kan hjælpe.

/Rex
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester