Save delområde af ark med aut. navngivning

Opret en ny workbook, hvor du så kopierer arket med fakturaen over i. Gem derefter den nye workbook med det filnavn, som din faktura skal have.

ja det kunne være en mulighed, men det skulle gerne automatiseres, da jeg jo skriver en del fakturaer og gerne ville ordne det at gemme den nye faktura med et tryk på makroen.

Åh, undskyld. Jeg fik på fornemmelsen, at du godt kunne kode, men blot havde brug for en idé til hvordan.

Hvilken mappe skal fakturaen gemmes i? Hvor står fakturanummeret?

Hej jeg har lige kopieret makroen ind som driller, jeg har anført hvad de enkelte dele skal kunne.. Om jeg kan kode?!? hehe.. overhovedet ikke, men har da fået has på en masse funktioner via andre makroer i workbook'en mangler efterhånden kun den vedlagte makro og ja kodningen er sikkert håbløs omstændig, men virker da :-) Min viden om makroer og regneark ligger tilbage fra da den slags hed SuperCalc.



Sub Faktura()
'
' Faktura Makro
' Makro indspillet 21-03-2008 af ibm
'
' Renser arker for kopistumper og uønskede celleformater fra ordrearket

'
    Worksheets("Fakturaudstedelse").Select
    Range("B18").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("B13:C15").Select
    Selection.NumberFormat = "@"
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Interior
        .ColorIndex = 2
        .PatternColorIndex = xlAutomatic
    End With
    Range("H18").Select
    Selection.NumberFormat = "#,##0.00"
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    'tildeler automatisk nummer til faktura, startsekvens checkup i U11
   
   
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[8]C[13]:R[9]C[13])"
    Range("H3").Select
    Selection.Copy
    Range("H3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("U11").Select
    ActiveSheet.Paste
    Range("A1").Select
   
    ' Sætter forfaldsdato 8 dage netto udenom lør- og søndage
   
   
    Worksheets("Fakturaudstedelse").Range("D50") = Date + 8 + IIf(Weekday(Date + 8) = 1, 1, IIf(Weekday(Date + 8) = 7, 2, 0))
    '
    ' printer faktura samt gemmer den i mappen som angivet i fil og stinavn
   
    ActiveSheet.PageSetup.PrintArea = ("A1:I53")
    ActiveSheet.PrintOut Copies:=1, Collate:=True
    Application.DisplayAlerts = False
    Range("A1:I53").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Fakturaudstedelse").SaveAs Filename:="Fak", FileFormat:=xlTemplate
    Stinavn = "C:\Documents and Settings\IBM T40\Dokumenter\Faktura.DAVIR\"
    Filnavn = Stinavn & "fak" & Format(Worksheets("Fakturaudstedelse").Range("H3"), "000000")
   
    ' checker om filnavn allerede er brugt = fejl i sekvnes eller allerede printet fak.
   
    If Dir(Filnavn & ".xls") = "" Then
        Filename = Filnavn
       
        Else
        MsgBox "Fakturanummer eksisterer allerede. Programmet afsluttes", vbCritical + vbOKOnly, "Kritisk fejl!"
        Application.Quit
    End If
   
   

    End Sub

Er det arket fakturaudstedelse, der skal gemmes "alene"?
Hvis ja, hvorfor gemmer du det som en template?
Og hvorfor gemmer du, inden du har tjekket, om filnavnet eksisterer i forvejen?
Findes fakturanummeret i arket fakturaudstedelse - og i hvilken celle?

Ja det er kun det ene ark der skal gemmes. Aner ikke jeg gemmer det som template jeg var inde på en anden tråd her på sitet, hvor jeg snuppede denne fordi jeg troede den virkede :-) Øhh.. ja det med at gemme først var også fra den. Som sagt ved jeg jo næppe pricis hvad jeg laver eller om det er den 'smarte' måde. But still learning.. fakturanummeret findes i celle H3 i arket.

P.S når det er gemt skal det kun være værdier og ikke som fil/cellereferencer da det jo ændrer sig ved næste faktura.

Sæt følgende kode ind i vba.

*******************
Public Sub SaveInvoice()
    Dim objWB As Workbook
    Dim objWS As Worksheet
    Dim objNewWB As Workbook
    Dim objInvoiceWS As Worksheet
    Dim strInvoiceNo As String
    Dim strPath As String
    Dim strFileName As String
    Dim objInvoiceArea As Range
   
    Set objWB = ActiveWorkbook
    Set objWS = objWB.Sheets("Fakturaudstedelse")
    strInvoiceNo = objWS.Range("H3")
    strPath = "C:\Faktura\" '"C:\Documents and Settings\IBM T40\Dokumenter\Faktura.DAVIR\"
    strFileName = strPath & "fak" & strInvoiceNo & ".xls"
   
    If Dir(strFileName) = "" Then
        Set objNewWB = Workbooks.Add
        objWS.Copy objNewWB.Sheets(1)
        Set objInvoiceWS = objNewWB.Sheets("Fakturaudstedelse")
        Set objInvoiceArea = objInvoiceWS.Range("A1").CurrentRegion
        objInvoiceArea.Copy
        objInvoiceArea.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.DisplayAlerts = False
        objNewWB.SaveAs strFileName
        Application.DisplayAlerts = True
        objNewWB.Close
    Else
        MsgBox "Filen " & strFileName & " eksisterer i forvejen.", vbCritical, "Gem faktura"
    End If
   
    Set objWB = Nothing
    Set objWS = Nothing
    Set objNewWB = Nothing
    Set objInvoiceWS = Nothing
    Set objInvoiceArea = Nothing
End Sub
*******************

Den erstatter det kode, som står efter print af faktura, dvs. alt fra

    Application.DisplayAlerts = False
    Range("A1:I53").Select

skal erstattes af et kald af den procedure, som jeg har lavet. Det gøres ved at skrive:

    Call SaveInvoice

Vær opmærksom på, at koden også lukker den nye fil (kan selvfølgelig fjernes, hvis du synes, at det er rart lige selv at se fakturaen og lukke den manuelt).

Det er jo fanfuckingtastisk ;-) sådan, jeg rettede lige den første "c:\faktura" og så var den der.. det eneste er at den ikke lukker den nye wordbook. Kan se du har skrevet objnewwb.close men den bliver stående som 'mappe4' kan man ændre det?

ups.. alt er jo cellerefs i den fak der skifter næste gang jeg skriver en eller sorterer kundedata og tilbudsdata i ny orden, så ændrer den vel også den gemte fak. så vidt jeg kan se er det jo stadig de samme cell refs?

Godt at du så det med stien. Glemte bare lige at fjerne det, der skulle til hos mig for at få gemt fakturaen.

Der skulle ikke så gerne være cellereferencer i fakturafilen. Jeg kopierer alt fra A1-sidste celle med indhold (forudsat at du ikke har f.eks. tomme kolonner/rækker) og sætter det ind samme sted med værdier og ikke hverken formler eller referencer (linjen med objInvoiceArea.PasteSpecial Paste:=xlPasteValues).

Men hvad mener du med, at alt er cellerefs i den fak der skifter? Tænker du på den oprindelige fil? Den har jeg ikke lavet ændringer til.

det er perfekt smid lige et svar..

tillægsspørgsmål. Jeg har fået lavet den sådan at den smider fak nummeret over i min ordrebase, men der kan være op til 3 fakturaer tilknyttet hver linie derfor er en kolonne ikke nok. Jeg behøver en makro der kan se om der står et fak nummer i forvejen, køre det ud i kolonnen til højre og smide det nye nummer ind der hvor det andet stod. Det med at smide det nye nummer ind har jeg fod på det er det med at gennemgå og 'flytte' det eksisterende en kolonne til højre og hvis der også står et så flytte det en tak til højre også.. Smider lige lidt ekstra point på for svaret..

Altså:
Hvis der står noget i H3 og i I3, så skal værdien af H3, sættes ind i I2
Hvis der står noget i H3, men ikke i I3, så skal værdien af H3, sættes ind i I3

Er det korrekt?

nope, jeg har en del af fakturamakroen der sammenligner den aktuelle fakturas ordrenummer-reference med den linie i tilbuds/ordre matrixen og når den finder et match smider fakturanummeret over i kolonne s, hvis der allerede står et nummer i s fra en tidligere faktura skal den smide den i kolonne t, hvis der står en der også skal den smide den i kolonne u. Så kan der ikke være flere fak per ordre.

apropos så gemmer den i fakturamappen stadig som en lopslagsværdi istedet for blot værdien, kan det fucke op på et tidspunkt? Jeg vil gerne at fak aldrig kan ændre sig når den er kopieret ud af systemet??

ok.. fandt selv ud af det .. wordhaj smid lige et svar så du kan få pointene.. ;-)

Kommer her.

Hvad var problemet så?

lader den gemme som pdf fil ;-)