Macro i excel med auto save/gem

Hej.

Kan du prøve at sætte op i punkter, hvad makroen skal lave?

Jeg kunne forestille mig noget i denne retning.

1. Lav fakture
2. Print
3. Gem
4. Reset workbook så den er klar til at starte forfra med punkt 1.

Hvis dette er den struktur, du vil have, kan jeg forstå du har 1 og 2?

Hvis der er rigtigt, kan jeg godt hjælpe dig med det sidste.

/1.

Du har ret det er 1 og 2 jeg har og det lyder godt, hvis du vil hjælpe med den sidste del

forresten, der er jo osse det med automatisk fakturanr + auto. opdatering af dato på faktura og den skulle gerne huske fakturanr.

Kan du sende din workbook eller smide den kode, der genererer fakturaen her, så jeg ved lidt om, hvad der skal resettes mm - evt. lidt hjælp til selvhjælp så du også lærer noget af det selv.

Hvis du vil sende til mig er adressen mathias.bogsted_at_gmail.com <- Erstat _at_ med @.

Skal det hele foregår i en makro eller skal der brugerinput (tryk på knap) mellem hver action?

/1

Jeg prøver at lære om det, men er lige begyndt.
Men jeg har sendt workbook til dig

Dette skal ind i din kode. Jeg skal bare vide, hvad der skal resettes.
Som det er nu bliver kun A19:L47 slettet, men jeg går ud fra at adressen, deres ref. mm også skal resettes. Jeg skal bare vide hvilke celler det er.

'Tjekker om filen allerede er gemt (hvis du har åbnet en gammel faktura).
'Hvis det er en gammel faktura overskrives denne bare.
'Hvis det er en ny faktura gemmes en kopi i undermappen faktura
If ActiveWorkbook.Name = Range("H14") & ".xls" Then
    ActiveWorkbook.Save
Else
    ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\Faktura\" & Range("H14") & ".xls"
End If

'Resetter workbooken
Range("A19:L47").ClearContents

Jeg skal nok sende workbooken med opdateringer når den er helt færdig.

/1

Fakturaerne kan også gemmes et anden sted, hvis i allerede har en mappe.

dette er de cellenr. der skal resettes:

B2->B5
D12 & D14
og så dem du allerede har noteret A19-> L47

:-)
Du skriver dette:'Hvis det er en gammel faktura overskrives denne bare.
hvis den er lavet til den skal automatisk opdatere fakt.nr.Vil den så osse overskrive fakturanr. med nyt???

Faktura nummeret vil være det samme.. med overskrive mener jeg at den gemmer ændringer.

Her er så det færdige resultat. Jeg har også sendt det til din mail.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim Ny, Svar
    Sheets("Faktura").Activate
    If Range("H14") = "" Or Right(Range("H14"), 2) <> Format(Now(), "yy") Then
        Range("H14").Value = "0001 - " & Format(Now(), "yy")
    End If
    Ny = Format(Left(Range("H14"), 4) + 1, "0000") & " - " & Format(Now(), "yy")
    Svar = MsgBox("Indsæt nyt Faktura nr. ", vbOKCancel)
    If Svar = 1 Then Range("H14").Value = Ny
    Range("L14").Value = Now()
   
    'Tjekker om filen allerede er gemt (hvis du har åbnet en gammel faktura).
    'Hvis det er en gammel faktura overskrives gemmes ændringer.
    'Hvis det er en ny faktura gemmes en kopi i undermappen faktura
    If ActiveWorkbook.Name = Range("H14") & ".xls" Then
        ActiveWorkbook.Save
    Else
        ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\Faktura\" & Range("H14") & ".xls"
    End If
   
    'Resetter workbooken
    Range("A19:L47").ClearContents
    Range("D12").ClearContents
    Range("D14").ClearContents
    Range("B2").Value = "NAVN"
    Range("B3").Value = "ADRESSE"
    Range("B4").Value = "By & POST NR"
End Sub

/1.

Jeg tænkte mig ikke lige om med hensyn til det var beforepring makroen blev kørt.

Derfor skal der resten af scriptet køres efter print (save_and_reset skal lægges i et separat module - ikke workbook module:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim Ny, Svar
    Sheets("Faktura").Activate
    If Range("H14") = "" Or Right(Range("H14"), 2) <> Format(Now(), "yy") Then
        Range("H14").Value = "0001 - " & Format(Now(), "yy")
    End If
    Ny = Format(Left(Range("H14"), 4) + 1, "0000") & " - " & Format(Now(), "yy")
    Svar = MsgBox("Indsæt nyt Faktura nr. ", vbOKCancel)
    If Svar = 1 Then Range("H14").Value = Ny
    Range("L14").Value = Now()
   
    Application.OnTime Now, "save_and_reset"
End Sub

Function save_and_reset()
    'Tjekker om filen allerede er gemt (hvis du har åbnet en gammel faktura).
    'Hvis det er en gammel faktura overskrives gemmes ændringer.
    'Hvis det er en ny faktura gemmes en kopi i undermappen faktura
    If ActiveWorkbook.Name = Range("H14") & ".xls" Then
        ActiveWorkbook.Save
    Else
        ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\Faktura\" & Range("H14") & ".xls"
    End If
   
    'Resetter workbooken
    Range("A19:L47").ClearContents
    Range("D12").ClearContents
    Range("D14").ClearContents
    Range("B2").Value = "NAVN"
    Range("B3").Value = "ADRESSE"
    Range("B4").Value = "By & POST NR"
End Function

/1