Automatisk fakturanummer

Jeg har selv løst problemet - håber ikke at der er nogle som har spildt unødig tid!

Spørgsmålet er et typisk spørgsmål omkring faktura - hvordan løste du det ?

Jeg fandt følgende tidligere forklaring, som virker fint. Det skal dog siges at i starten virkede det godt, så lavede jeg et eller andet??? og så ville det ikke virke mere. Af frygt for at fu... min faktura op valgte jeg at slette koden og indtaste den manuelt. Så jeg har faktisk ikke helt løst problemet

Men her er det tidligere svar:

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