Avatar billede kims0809 Nybegynder
03. marts 2008 - 13:30 Der er 7 kommentarer og
1 løsning

Danne fakturaer ud fra excel fil

Hej

Vi skal have lavet et script til at trække oplysninger ud fra en EXCEL fil, i et format så de kan udskrives eller i det mindste så vi kan have dem enkeltvis på en fil som fakturaer. Hvordan fakturaen skal sætte op kan vi fortælle.

Selve filen som dataene skal hentes fra ser således ud:
http://templates.dk/skabelon.xls


Et af de problemer jeg kan se er at der ikke kun er 1 faktura pr. linie, nogle gange er det flere linie som skal lægges sammen til én faktura og andre gange er det kun 1 linie der skal laves til én faktura. Men måske kan systemet bruge den kolonne der hedder kolli til dette, da der faktisk står hvor mange linier der skal med på fakturaen, eller ville den nok skulle tjekke noget med at ”ordrenummer” er det samme og derfor skal på den samme faktura, men det vil nok betyde at den skal læse igennem alle 2500 linier som er i excel filen, hver gang der kommer et nyt ordrenummer nummer, for at tjekke for duplikater eller lignende.
Alle fakturaerne skal have tildelt deres eget nummer, som bare starter fra fx 1 og kører op ad, dvs ordrenummer og fakturanummer er ikke det samme.

Til sidst skal den også regne beløbende sammen, så der står i alt med moms osv.

Vi ønsker gerne et tilbud på dette eller betaler gerne for den tid der bruges, hvis ikke det er ALT for dyrt ;-)
Avatar billede giorgio Nybegynder
03. marts 2008 - 13:57 #1
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.
Avatar billede giorgio Nybegynder
03. marts 2008 - 13:59 #2
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
Avatar billede kims0809 Nybegynder
03. marts 2008 - 14:00 #3
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.
Avatar billede kims0809 Nybegynder
03. marts 2008 - 14:01 #4
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.
Avatar billede supertekst Ekspert
03. marts 2008 - 17:49 #5
Det kunne jeg godt blive interesseret i - har hentet skabelon.

Hvis yderligere info herom <-> kontakt evt.:
pb@supertekst-it.dk
Avatar billede finnp45 Nybegynder
06. marts 2008 - 17:35 #6
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
Avatar billede supertekst Ekspert
12. marts 2008 - 18:26 #7
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
Avatar billede supertekst Ekspert
28. april 2008 - 22:21 #8
Måske skulle vi lukke...
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