Autonummerering af faktura

Det ville nok være en ide at lukke dette spørgsmål. Med mindre du vil give mig nogle flere point ;-)

Sig endelig til hvis du ikke kan få det til at virke i Acces. Send evt en mail på soren@sj-gren.dk.

Jamen så må jeg da hellere lukke dette spørgsmål..

Hilsen jkan

Øv :-(

Det er muligt - også uden access.

Du skal benytte en makro og have en "fast" filsystem.
Herefter kan du med en makro se de sidste nummer i rækken - og dernæst indsætte den næste nummer i rækken i det nye regneark.

Skal du havde hjælp eller vil du lukke dette spm?

Det er ikke sikkert jkan har brug for hjælp til dette spørgsmål - men det vil jeg meget gerne :-)

Palle>> Hvad vil du byde?? *S*

Tjah hva' har du brug for???*S*

Tja...
Men benyt dig som Fl. siger af Makro.

/MCP

hvad med at bruge den faktura der er i office pakken den kan selv opdatere til et nyt fakturanummer hver gang du åbner en ny mappe (skabelon)

Ja, men ak du kan ikke bruge Vopslag eller Lopslag - så derfor dur den ikke, og du kan ikke komme ind og se koderne for den

er spørgsmålet stadig aktuelt jeg har et svar der virker

Jeg har også fundet en løsning i mangel af bedre - ved at bruge TÆL, men der må være en mere hensigtsmæsig end den

det er der også, en makro og aktiv x- element det vil sige det er lidt programering i vb der skal til

Tak, det er ikke lige min stærke side, det der med vb - :-)

slip lige nogle point sa kan jeg lave det til dig du opretter bare et nyt spørgsmål

Her er to metoder til at gøre godt med. Begge skal indsættes i skabelonen. Rutinen bruger Excels Open-event.
1. Stå i arket og tast <Alt><F11> for at komme til VBA editoren.
2. Find skabelonen i projektvinduet (øverst til venstre) og dobbeltklik på \"ThisWorkbook\".
3. Indsæt én af rutinerne.

Den første rutine lægger/henter oplysningerne i en INI-fil, og er god, hvis flere brugere skal bruge systemet. Den anden rutine lægger/henter oplysningerne i registreringsdatabasen.
Ret selv til dine aktuelle navne.

Med venlig hilsen
LeoH


Første metode:

Private Declare Function GetPrivateProfileString Lib \"kernel32\" Alias \"GetPrivateProfileStringA\" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib \"kernel32\" Alias \"WritePrivateProfileStringA\" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private Sub Workbook_Open()
\'leo.heuser@get2net.dk juni 2000
\'Fra skabelonen sættes reference til
\'Microsoft Visual Basic for Applications Extensibility 5.3
\'i menuen Funktioner (Tools)
Dim WorksheetName As String
Dim WorksheetCell As String
Dim Section As String
Dim kKey As String
Dim lLine As Long
Dim InvoiceNumber As Long
Dim InvoiceNumberCell As Object
Dim TemplateName As String
Dim IniFileName As String
Dim Dummy As Variant
   
    TemplateName = \"Erik2.xlt\"
    WorksheetName = \"Invoice\"
    WorksheetCell = \"F7\"
    Section = \"Invoice\"
    kKey = \"Number\"
    IniFileName = \"C:\\Windows\\Temp\\InvoiceNumber.txt\"
   
    Set InvoiceNumberCell = Worksheets(WorksheetName).Range(WorksheetCell)
    If UCase(ActiveWorkbook.Name) = UCase(TemplateName) Then GoTo Finito
    Dummy = GetString(Section, kKey, IniFileName)
    If Left(Dummy, 1) = Chr$(0) Then
        InvoiceNumber = 1
    Else
        InvoiceNumber = CLng(Dummy) + 1
    End If
    WritePrivateProfileString Section, kKey, CStr(InvoiceNumber), IniFileName
    InvoiceNumberCell.Value = InvoiceNumber
    With ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.CodeName).CodeModule
        lLine = .ProcBodyLine(\"Workbook_Open\", vbext_pk_Proc)
        .InsertLines lLine + 1, \"Exit Sub\"
    End With
Finito:
Set InvoiceNumberCell = Nothing
End Sub

Function GetString(Section As String, Key As String, File As String) As String
    Dim KeyValue As String
    Dim Characters As Long
    KeyValue = String(255, 0)
    Characters = GetPrivateProfileString(Section, Key, \"\", KeyValue, 255, File)
    If Characters > 1 Then
        KeyValue = Left(KeyValue, Characters)
    End If
    GetString = KeyValue
End Function
____________________________________

Anden metode:

Private Sub Workbook_Open()
\'leo.heuser@get2net.dk juni 2000
\'Fra skabelonen sættes reference til
\'Microsoft Visual Basic for Applications Extensibility 5.3
\'i menuen Funktioner (Tools)
Dim WorksheetName As String
Dim WorksheetCell As String
Dim SettingName As String
Dim lLine As Long
Dim InvoiceNumber As Variant
Dim InvoiceNumberCell As Object
Dim TemplateName As String
   
    TemplateName = \"Erik.xlt\"
    WorksheetName = \"Invoice\"
    WorksheetCell = \"F7\"
    SettingName = \"Erik\"
   
   
    Set InvoiceNumberCell = Worksheets(WorksheetName).Range(WorksheetCell)
    If UCase(ActiveWorkbook.Name) = UCase(TemplateName) Then GoTo Finito
    InvoiceNumber = GetSetting(SettingName, \"Invoice\", \"InvoiceNumber\")
    If InvoiceNumber = \"\" Then
        InvoiceNumber = 1
    Else
        InvoiceNumber = InvoiceNumber + 1
    End If
    SaveSetting SettingName, WorksheetName, \"InvoiceNumber\", InvoiceNumber
    InvoiceNumberCell.Value = InvoiceNumber
    With ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.CodeName).CodeModule
        lLine = .ProcBodyLine(\"Workbook_Open\", vbext_pk_Proc)
        .InsertLines lLine + 1, \"Exit Sub\"
    End With
Finito:
Set InvoiceNumberCell = Nothing
End Sub

Mange tak :-) nu tror jeg nok vi kan afslutte spørgsmålet, med det gode svar fra leoheuser, han fortjener mindst 600 point

Desværre har der indsneget sig en trykfejl.
Ret denne linie

InvoiceNumber = GetSetting(SettingName, \"Invoice\", \"InvoiceNumber\")

til

InvoiceNumber = GetSetting(SettingName, WorksheetName, \"InvoiceNumber\")

Med venlig hilsen
LeoH

Du kan godt lukke dette emne, og give point til Leo Heuser

Hmm, endnu et \"glemt\" spørgsmål!
Synd at et så godt svar ikke fortjener en belønning!