Auto nummering

Hvor bliver de tidligere bon-numre gemt - dvs. hvordan ved du hvilket nummer du er nået til?

Hvis det er skrevet i en database, i et andet regneark e.l. kan du jo hente det sidste bonnummer og lægge en til...

Eller - du kan når du har lavet kvitteringen trykke på en knap, der så skriver det aktuelle bon-nummer i en fil (vha. VBA). Næste gang excel startes op, kan du indlæse bonnummeret fra filen (vha VBA), og lægge en til...

Eller - hvad har du tænkt dig?

Det lyder meget fornuftigt, det med den henter nummeret fra en fil, men hvordan gemmer den det så.
Kviteringerne gemmes ikke på computeren, det var entelig meningen, men den forslår hele tiden det samme navn, og hvis den ikke kan gøre noget automatisk, kan jeg ikke bruge det.

Har engang for længe siden modtaget denne forklaring af en kammerat.

Der er flere måder at gøre dette på. Her er en metode, der gemmer ordrenummeret
i registreringsdatabasen, hvorfra det så hentes ind, gøres én større og indsættes i
den nye faktura. Den nye værdi gemmes dernæst i registreringsdatabasen.
Oplysningen gemmes i
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Navn

1.    Åbn din skabelon,
2.    Gå til VBA editoren med <Alt><F11>
3.    Find skabelonen i projektvinduet (øverst til venstre på skærmen) og dobbeltklik på "ThisWorkbook".
4.    I højre vindues venstre rulleboks vælges "Workbook"
5.    Indsæt nedenstående kode i højre vindue.

Private Sub Workbook_Open()
Dim Linie As Long
Dim Nummer As Variant
Dim PlacerOrdreNummer As Object
Dim SkabelonNavn As String

    SkabelonNavn = "Navn.xlt"
    Set PlacerOrdreNummer = Worksheets("Ark1").Range("A1")

    If ActiveWorkbook.Name = SkabelonNavn Then Exit Sub
    Nummer = GetSetting("Jens Jørgen", "Ordrenummer", "Nummer")
    If Nummer = "" Then
        Nummer = 1
    Else
        Nummer = Nummer + 1
    End If
    SaveSetting "Jens Jørgen", "Ordrenummer", "Nummer", Nummer
    PlacerOrdreNummer.Value = Nummer
    With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        Linie = .ProcBodyLine("Workbook_Open", vbext_pk_Proc)
        .InsertLines Linie + 1, "Exit Sub"
    End With
Set PlacerOrdreNummer = Nothing
End Sub

Ret selv linien
    Set PlacerOrdreNummer = Worksheets("Ark1").Range("A1")
til det ark og den celle, hvor det nye fakturanummer skal stå.

6.    Vælg Funktioner > Referencer og sæt "flueben" ved "Microsoft Visual Basic for Applications
        Extensibility". Denne reference er nødvendigt for at kunne bruge den interne konstant
        "vbext_pk_Proc".
7.    Gem skabelonen.


Makroen Workbook_Open() kører automatisk, når en projektmappe åbnes, eller når der dannes
en ny projektmappe ud fra en skabelon.
With-sløjfen tilføjer linien Exit Sub som første linie i Workbook_Open(), efter opdateringen er sket.
Derved forhindrer man, at fakturanummeret opdateres i registreringsdatabasen, hvis du åbner en fakturamappe, der *er* blevet gemt.

Hvis du åbner skabelonen for at rette i den, skal du huske at holde <Shift> nede,
lige indtil *det hele* er læst ind. På den måde forhindrer du Workbook_Open() i at blive aktiveret
og derved komme til at opdatere fakturanummeret.

Den melder fejl

    SkabelonNavn = "Regning.xlt"
-->>Set PlacerOrdreNummer = Worksheets("Ark1").Range("3B")

Private Sub Workbook_Open()
Dim Linie As Long
Dim Nummer As Variant
Dim PlacerOrdreNummer As Object
Dim SkabelonNavn As String

    SkabelonNavn = "Regning.xlt"
    Set PlacerOrdreNummer = Worksheets("Ark1").Range("3B")

    If ActiveWorkbook.Name = SkabelonNavn Then Exit Sub
    Nummer = GetSetting("Butiks navn", "Ordrenummer", "Nummer")
    If Nummer = "" Then
        Nummer = 1
    Else
        Nummer = Nummer + 1
    End If
    SaveSetting "Butiks navn", "Ordrenummer", "Nummer", Nummer
    PlacerOrdreNummer.Value = Nummer
    With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        Linie = .ProcBodyLine("Workbook_Open", vbext_pk_Proc)
        .InsertLines Linie + 1, "Exit Sub"
    End With
Set PlacerOrdreNummer = Nothing
End Sub

fejlen lyder - Run-time error '1004'

Rettelse. Skal siges at jeg ikke selv har afprøvet den, men en ven som skulle bruge den har afprøvet og brugt den

1.    Åbn din skabelon,
2.    Gå til VBA editoren med <Alt><F11>
3.    Find skabelonen i projektvinduet (øverst til venstre på skærmen) og dobbeltklik på "ThisWorkbook".
4.    I højre vindues venstre rulleboks vælges "Workbook"
5.    Indsæt nedenstående kode i højre vindue.

Private Sub Workbook_Open()
Dim Linie As Long
Dim Nummer As Variant
Dim PlacerOrdreNummer As Object
Dim SkabelonNavn As String

    SkabelonNavn = "Navn.xlt"
    Set PlacerOrdreNummer = Worksheets("Ark1").Range("A1")

    If ActiveWorkbook.Name = SkabelonNavn Then Exit Sub
    Nummer = GetSetting("Navn", "Ordrenummer", "Nummer")
    If Nummer = "" Then
        Nummer = 1
    Else
        Nummer = Nummer + 1
    End If
    SaveSetting "Navn", "Ordrenummer", "Nummer", Nummer
    PlacerOrdreNummer.Value = Nummer
    With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        Linie = .ProcBodyLine("Workbook_Open", vbext_pk_Proc)
        .InsertLines Linie + 1, "Exit Sub"
    End With
Set PlacerOrdreNummer = Nothing
End Sub

Ret selv linien
    Set PlacerOrdreNummer = Worksheets("Ark1").Range("A1")
til det ark og den celle, hvor det nye fakturanummer skal stå.

6.    Vælg Funktioner > Referencer og sæt "flueben" ved "Microsoft Visual Basic for Applications
        Extensibility". Denne reference er nødvendigt for at kunne bruge den interne konstant
        "vbext_pk_Proc".
7.    Gem skabelonen.


Skabelonen skal gemmes som en .xlt - fil i mappen
C:\Programmer\Microsoft Office\Skabeloner\Regnearksløsninger    eller i mappen
C:\Programmer\Microsoft Office\Office\Xlstart

Når du skal danne en ny faktura vælges Filer > Ny og den aktuelle skabelon vælges i "Generelt"
(hvis skabelonen var gemt i \Xlstart) eller i "Regnearksløsninger".

På den fil jeg har, er alle navne (der hvor der står NAVN)ens. Kan se at dit filnavn er forskelligt fra de andre steder hvor der står navn, her har du valgt butiksnavn. På min er skabelonnavnet brugt overalt. Måske er det nok til at få fejl

Du kan jo også bare gemme nummeret til en text-fil i stedet for i registreringsdatabasen, hvis det giver for mange problemer...

Hvis du vil det, kan du gøre følgende:

Åben et nyt regneark, og gem det som c:\test.xls
Indspil en ny macro med et tilfældigt navn (Funktioner -> Macro -> Indspil ny macro
Stop indspilningen.
Tryk Alt+F8 for at komme til macro-dialogboxen.
Marker din macro, og tryk "rediger"
Slet hele molevitten, og indsæt nedenstående kode.
Opret c:\Fil.txt, og skriv et tal i øverste linie (fx. 100)

Herefter vil regnearket når det åbnes indlæse tallet fra filen i celle A1, udregne et nyt tal i A2, og når du lukker regnearket skrives det nye tal i fil.txt...

Sub auto_open() 'Denne sub køres automatisk når regnearket åbnes i Excel
  filnummer = FreeFile
  Dim Varenummer As String
  Open "C:\Fil.txt" For Input As #filnummer
    Line Input #filnummer, Varenummer  'Putter 1. linie ind i Varenummer
  Close #filnummer
  Range("A1").Select
  ActiveCell.Value = Val(Varenummer)
  Range("A2").Select
  ActiveCell.Value = Val(Varenummer) + 1
End Sub
Sub auto_close() 'Denne sub køres automatisk når regnearket lukkes i Excel
  Dim filnummer As Integer
  filnummer = FreeFile
  Range("A2").Select
  Open "C:\Fil.txt" For Output As #filnummer
  Print #filnummer, ActiveCell.Value 'Skriver indholdet af celle A1 til filen
  Close #filnummer
End Sub

Herefter kan du bare rette til :o)

Har lige kontaktet min kammerat for at høre om det virkede hos ham, og han fortalte at det virkede perfekt hos ham

En ide til fejlkilde: Du forsøger at hente en setting med Getsitting, FØR at den er blevet sat. HVIS det er problemet, klares det med at slette getsetting første gang macroen køres, således at der bliver skrevet en setting med Savesetting. Herefter kan koden køres med Getsetting.
Hvis det ikke er fejlen, kunne det være rart at vide i hvilken linie fejlen kommer...

Anden løsning: Bruge mit forslag - simplere kan det vist ikke gøres ;o)

Jeg har et ark liggende, som viser hvordan det kan løses.
Den gemmer det nummer man er nået til i sit Excel-ark til en lille tekstfil.
Har selv brugt arket i flere modeller - det virker upåklageligt :-)

Interesseret så send lige mail - eller opgiv en mailadresse.

janvogt@esenet.dk

janvoigt> Øhh - det er jo LIGE PRÆCIS det jeg har givet et eksempel på - det er bare at copy-paste mit eksempel...

Martin> Ja, du har ret. Grundprincipperne ligner nok meget dit eksempel.
Ved bare ikke helt, om det er det cybermaster egentlig har brug for.

Jeg har også lavet et fakturaprogram, som finder det næste ledige nummer på en liste. Måske er det nærmere det der er brug for.

aovergaard

aovergaard >> nu virker det fint!!!
Men hvordan virker det med save funktionen, og er der en måde at reset nummerne på?

Dejligt at høre det virker nu. Så vidt jeg ved er der det lille minus at man ikke kan resette.

hvis du vil ændre i hvor langt den har talt, eller sætte den tilbage til nul, skal du ændre det i registreringsdatabasen. Hvis du vil vide hvor skal jeg nok finde det.

kom lige til at kigge alligevel
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\"Navn"

aovergaard & martin_moth >> Jeg startedet med at bruge aovergaard løsning, men synes alligevel at martins løsning var den mest simple, med et text fil der læses til og fra.
Jeg sætter pointene op til 200 og spiltter så i få 100 hver.

Håber det er ok, på den måde.
Tak for hjælpen, i har gjort det meget nemmere for mig, og gjort min revisor glad, da der nu kan komme lidt system i nummerene ;-)

/Cybermaster

Tak for point :-) og det er bare helt ok med 100 til os hver. Rar fornemmelse at kunne hjælpe en ven i nøden

aovergaard ;-)

Ligger lige den færdige løsning, til jer andre, og når jeg på et eller andet tidspunkt skal bruge det igen.

------------------------------------------------------------------------------

Sub auto_open() 'Denne sub køres automatisk når regnearket åbnes i Excel

'Går ud af løkken hvis filnavnet indeholder tegnet #
If InStr(ActiveWorkbook.Name, "#") > 0 Then
Exit Sub
End If

filnummer = FreeFile
Dim Varenummer As String

'Her ligger textfilen der indeholder nummeret den er kommet til.
Open "C:\butik Salgsbilag\regning_nr.txt" For Input As #filnummer
Line Input #filnummer, Varenummer 'Putter 1. linie ind i Varenummer
Close #filnummer
Range("B3").Select
ActiveCell.Value = Val(Varenummer)
Range("B3").Select

'Rykke så den aktive celle er "A4" istedet for B3
ActiveCell.Value = Val(Varenummer) + 1
Range("A4").Select

End Sub
Sub auto_close() 'Denne sub køres automatisk når regnearket lukkes i Excel

'Går ud af løkken hvis filnavnet indeholder tegnet #
If InStr(ActiveWorkbook.Name, "#") > 0 Then
Exit Sub
End If

Dim filnummer As Integer
filnummer = FreeFile
Range("B3").Select

'Her ligger textfilen der indeholder nummeret den er kommet til.
Open "C:\butik Salgsbilag\regning_nr.txt" For Output As #filnummer

Print #filnummer, ActiveCell.Value 'Skriver indholdet af celle A1 til filen
Close #filnummer
FilNavn = Range("B3").Value

'Hvis mappen med årstallet ikke findes bliver den oprettet
  If Dir("C:\butik Salgsbilag\" & Year(Date), vbDirectory) <> "" Then
  Else
    MkDir "C:\butik Salgsbilag\" & Year(Date)
  End If
 
  'Indsætter excel documentet fx: 37# 06-12.xls
ActiveWorkbook.SaveAs Filename:="C:\butik Salgsbilag\" & Year(Date) & "\ " & FilNavn & "# " & Format(Date, "dd-mm") & ".xls"

End Sub

Takker mange gange ;-)