Danne fakturaer ud fra excel fil

har i overvejet at kigge på economic? det er et regnskabsprofram og det kan håndtere csv data. en anden fed funktion er deres API'er hvor du kan få en webshop til at arbejde direkte deri, det kan spare meget tid og mange penge.

jeg bruger det selv dog ikke api delen, og jeg er mere end tilfreds. jeg udsender idag kun faktira pr. e-mail ud direkte igennem economic.

et stort plus er helt klart prisen, den er ikke høj for det man får og backup skal man ikke tænke på.

du kan oprette et "prøveregnskab" på economic.dk i 14 dage og prøve at rode med det.

du kan se alle deres vejledninger her også til import af data: http://www.e-conomic.dk/hotline/guides/helpcenter00.asp?nav=footer

især "Import og opdatering af debitorer" minder om den du beskriver

jo tak, men vi skal have dette klaret først, da det er nogle data som skulle være brugt sidste år, vi er gået over til et andet regnskabssystem, så dette bliver ikke et problem i fremtiden. Men tak for infoen ellers.

Jeg tror desværre ikke at den nævnte løsning kan klare det, og det ville også være skønnere ikke at skulle til at sætte sig ind i et regnskabssystem for at få det her til at virke.

Det burde ikke være super svært for en EXCEL nørd.

Det kunne jeg godt blive interesseret i - har hentet skabelon.

Hvis yderligere info herom <-> kontakt evt.:
pb@supertekst-it.dk

Jeg bruger selv kun Excel til fakturering og brevskrivning.
Fordelen er at når man ændrer firmadata eller layout etc. er det samme fil.
Jeg har en lille kundedatabase hvorfra der kan indsættes Firmanavn, Attn, adresse, by og land.
Endvidere overføres faktura-data til en anden fil: fakturaliste, hvor jeg afkrydser når der betales, herved har jeg præcis tal på hvor meget der er faktureret i år, og hvor meget der ikke er betalt endnu.
Det er fra filen Fakturaliste der hentes fortløbende fakturanummer.
Selve faktura filen gemmes automatisk med filnavnet: "Fakturanummer & Firmanavn & Fakturaoverskrift & dato.xls".

Jeg kan lave noget som dette, men tilpasset aktuelle ønsker.
kontakt evt. info@chimneylab.dk

Løsningen blev denne:

Rem SYSTEM-MODEL 3 06-03-2008
Rem =========================

Rem SystemMappen
Dim mappeSti

Rem OrdreFilen
Dim OrdXLS, antalOrdreRækker
Const ordreFilNavn = "Ordre.xls"
Const ordreArk = "Ark1"

Dim enhedNr, enhedTekst, Antal, vareNr, vareTekst, prisMM, prisUM, ordreNr, ordreDato, Firma, Navn, Adresse, postNr, By, tlfNr, faktNr
Dim antalOrdreLin, OrdreLinRækker As String

Rem FakturaFilen
Dim FakXLS
Dim sideNr

Const fakturaSkabelonNavn = "Faktura skabelon.xls"
Const fakturaArkNavn = "Faktura"
Dim aktuelleFakturaArk

Rem FakturaMappe (Arkiv)
Const FakturaArkiv = "Faktura"
Dim fraFakturaNr, tilFakturaNr, antalFaktura

Rem SystemFil
Dim sysXLS, pnrXLS
Dim fakturaNr                                      'næste fakturanr
Dim Fragt
Dim enhedsTekster(6)
Public Sub startFakturering()                      'workbook_activate()
Rem find systemMappe-stien
    mappeSti = findSti
   
Rem hent data fra Systemfil
    Set sysXLS = ActiveWorkbook.Sheets("System")
    Set pnrXLS = ActiveWorkbook.Sheets("Postnr")
   
    fakturaNr = sysXLS.Cells(1, 2)
    Fragt = sysXLS.Cells(2, 2)                      'eksl. moms
    opsætningAfEnhedsTekster
   
Rem HouseKeeping
    antalFaktura = 0
    fraFakturaNr = fakturaNr
    aktuelleFakturaArk = fakturaArkNavn
   
Rem HovedProcess
    åbnOrdreFilen
    antalOrdreRækker = beregnAntalOrdreRækker
   
    behandlingAfOrdre
   
    lukOrdreFilen

Rem Opdater FakturaNr
    sysXLS.Cells(1, 2) = fakturaNr

Rem Clear systemFil-object
    Set sysXLS = Nothing
    Set pnrXLS = Nothing
   
Rem Gem System-Filen -hvis der er faktureret
    If antalFaktura > 0 Then
        ActiveWorkbook.Save
        tilFakturaNr = fakturaNr - 1
   
        MsgBox ("Antal faktura: " & CStr(antalFaktura) + vbCr + "Fra Nr.: " + CStr(fraFakturaNr) + vbCr + "Til Nr.: " + CStr(tilFakturaNr))
    Else
        MsgBox ("Ingen faktura er opbygget")
    End If
   
End Sub
Private Function findSti()
    findSti = ActiveWorkbook.Path
    If Right(findSti, 1) <> "\" Then
        findSti = findSti + "\"
    End If
End Function
Private Sub opsætningAfEnhedsTekster()
Dim ix
    ix = 1
    With sysXLS
        For k = 2 To 6
            enhedsTekster(ix) = .Cells(2, k)
            ix = ix + 1
        Next k
    End With
End Sub
Private Sub åbnOrdreFilen()
    Set OrdXLS = CreateObject("Excel.Application")
    With OrdXLS
        .Workbooks.Open mappeSti + ordreFilNavn
    End With
End Sub
Private Function beregnAntalOrdreRækker()
Dim ws As Worksheet, bruttoRækker, ræk
    Set ws = OrdXLS.Worksheets(ordreArk)
    bruttoRækker = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row - 1
   
    For ræk = 2 To bruttoRækker
        If ws.Range("W" & CStr(ræk)) <> "" Then
            beregnAntalOrdreRækker = ræk - 1
            Exit Function
        End If
    Next ræk
   
    beregnAntalOrdreRækker = bruttoRækker
End Function
Private Sub lukOrdreFilen()
On Error GoTo lukObjekt

    With OrdXLS
        .Application.DisplayAlerts = False
        .ActiveWorkbook.SaveAs mappeSti + ordreFilNavn
        .ActiveWorkbook.Close
        .Application.Quit
        .Application.DisplayAlerts = True
    End With
   
lukObjekt:
    Set OrdXLS = Nothing
End Sub
Private Sub behandlingAfOrdre()                    'gennemløb af ordre-linier
Dim ræk, ordreNr
    Application.ScreenUpdating = False

    For ræk = 2 To antalOrdreRækker
        With OrdXLS
Rem check om der er faktureret - kolonne W - hvis udfyldt(faktnr)= er faktureret
            If .Range("W" & CStr(ræk)) = "" Then
                hentOrdreStamData CStr(ræk)
                findFlereLinier ræk
               
Rem Hvis der er 1 - x ordrelinier, der IKKE er faktureret så Fakturer nu
                If antalOrdreLin > 0 Then
                    sideNr = 1
                    aktuelleFakturaArk = fakturaArkNavn
                    opbygFaktura
Rem Optæl FakturaNr
                    fakturaNr = fakturaNr + 1
                    antalFaktura = antalFaktura + 1
                End If
            End If
        End With
    Next ræk
    Application.ScreenUpdating = True
End Sub
Private Sub hentOrdreStamData(ræk)                      'hent ordre-STAM data fra første række, der ikke er fakt.
    With OrdXLS
        ordreNr = .Range("I" & ræk)
        ordreDato = .Range("J" & ræk)
        Firma = .Range("P" & ræk)
        Navn = .Range("Q" & ræk)
        Adresse = .Range("R" & ræk)
        postNr = .Range("S" & ræk)
        tlfNr = .Range("T" & ræk)
    End With
End Sub
Private Sub findFlereLinier(række1)                    'er der flere lnier med samme Ordrnr
Dim ræk
    antalOrdreLin = 0                                  'opsætning af første række
    OrdreLinRækker = ""
   
    For ræk = række1 To antalOrdreRækker
Rem Hvis samme ordrenr og ikke faktureret
        If ordreNr = OrdXLS.Range("I" + CStr(ræk)) And OrdXLS.Range("W" & CStr(ræk)) = "" Then
            antalOrdreLin = antalOrdreLin + 1
            OrdreLinRækker = OrdreLinRækker + CStr(ræk) + "|"
           
            OrdXLS.Range("W" & CStr(ræk)) = fakturaNr
        End If
    Next ræk
End Sub
Private Sub hentOrdreLinData()                          'hent ordre-linier med samme ordrenr.
Dim p, ræk
    p = InStr(OrdreLinRækker, "|")
    If p > 0 Then
        ræk = Left(OrdreLinRækker, p - 1)
        With OrdXLS
            Antal = .Range("B" & ræk)
            vareNr = .Range("C" & ræk)
            vareTekst = .Range("E" & ræk)
            prisMM = .Range("H" & ræk)
            prisUM = prisMM / 1.25
        End With
       
        OrdreLinRækker = Mid(OrdreLinRækker, p + 1)
    End If
End Sub
Private Sub opbygFaktura()
Dim ws As Worksheet, linieRæk, linieNr, maxRækker
    Set FakXLS = CreateObject("Excel.Application")
    FakXLS.Workbooks.Open mappeSti + fakturaSkabelonNavn
    Set ws = FakXLS.Worksheets(aktuelleFakturaArk)
    ws.Activate
   
Rem Beregn antal detail-rækker på siden - Fra side 2 kun 9 - idet 1 anvendes til "transport"
    If sideNr = 1 Then
        maxRækker = 10
    Else
        maxRækker = 9
    End If
   
Rem FakturaHoved (Stamdata)
    With ws
        .Range("F5").Value = CStr(ordreDato) + "/" + CStr(ordreNr)
        .Range("F8").Value = fakturaNr
        .Range("C14").Value = Navn
        .Range("C15").Value = Firma
        .Range("C16").Value = Adresse
        .Range("C17").Value = CStr(postNr) + "  " + findBy(postNr)
        .Range("C18").Value = tlfNr
    End With
   
Rem linie-data
    linieRæk = 21
    For linieNr = 1 To antalOrdreLin
        hentOrdreLinData
        Set ws = FakXLS.Worksheets(aktuelleFakturaArk)
        With ws
            .Range("A" & CStr(linieRæk)) = Antal
            .Range("C" & CStr(linieRæk)) = vareNr
            .Range("D" & CStr(linieRæk)) = vareTekst
            .Range("E" & CStr(linieRæk)) = prisUM
'            .Range("F" & CStr(linieræk)) = Antal  'Beregnes via indbygget formel

            linieRæk = linieRæk + 1

Rem Test om der skal udføres sideskift (nyt ark)
            If linieRæk > 30 And antalOrdreLin > maxRækker Then
                IndsætNæsteSide .Range("F31").Value 'Transport
                linieRæk = 22
                antalOrdreLin = antalOrdreLin - maxRækker
            End If
        End With
    Next linieNr
       
    Set ws = FakXLS.Worksheets(aktuelleFakturaArk)
    With ws
     
Rem Deltotal 1
'        .Range ("F31")                            'Beregnes via indbygget formel
        .Range("F32").Value = Fragt
Rem Deltotal 2
'        .Range ("F33")                            'Beregnes via indbygget formel
Rem Moms-sats
'        .Range("F34")                              'Er anført i skabelon
Rem moms-beløb
'        .Range("F35")                              'Beregens via indbygget formel
Rem I alt
'        .Range("F36")                              'Beregnes via indbygget formel
    End With
   
On Error GoTo lukObjekt
   
    Application.StatusBar = "FakturaNr.: " & fakturaNr
   
    With FakXLS
        .ActiveWorkbook.SaveAs mappeSti + FakturaArkiv + "\Faktura " + CStr(fakturaNr) + ".xls"
        .ActiveWorkbook.Close
        .Application.Quit
   
lukObjekt:
        Set FakXLS = Nothing
    End With
   
    Set ws = Nothing
End Sub
Private Function findBy(pnr)
    With pnrXLS.Range("A1" & ":A65000")
        Set c = .Find(pnr, LookIn:=xlValues, LookAt:=xlPart)
            If Not c Is Nothing Then
                ræk = c.Row
                findBy = pnrXLS.Cells(ræk, 2)
            Else
                findBy = "???"
            End If
    End With
End Function
Private Sub IndsætNæsteSide(transport)
Dim antalArk, ws
    sideNr = sideNr + 1
   
Rem Opret SideArk efter Arket Faktura med navnet SideX, hvor X = sideNr
    With FakXLS.ActiveWorkbook
        antalArk = .Sheets.Count

Rem kopier forrige ark
        .Sheets(antalArk).Select
        .Sheets(antalArk).Copy After:=.Sheets(antalArk)

Rem Slet visse felter på siden, der kopieres
        .Unprotect
        .Sheets(antalArk).Range("F33:F36").Locked = False
        .Sheets(antalArk).Range("F33:F36").ClearContents
        .Sheets(antalArk).Range("E31").Value = "Transport"
       
Rem AktuelleFakturaArk skal justeres...........
        aktuelleFakturaArk = .Sheets(antalArk + 1).Name
    End With
   
    Set ws = FakXLS.ActiveWorkbook.Sheets(sideNr)
       
Rem Tilpasning af NYT ark - slet detaillinier
    With ws
        .Range("A21:E30").ClearContents            'slet detaillinier
        .Range("F9").Value = "Side " & CStr(sideNr) 'Sidenr under fakturaNr
        .Range("A21").Value = 1
        .Range("D21").Value = "Transport"
        .Range("E21").Value = transport
    End With
End Sub

Måske skulle vi lukke...