Kopier og åbne excel fil

Du er velkommen til at sende filen - @-adresse under min profil.

Der er sendt en kopi til dig :)

Næstsidste udgave - sidste er suppleret med aktivering via knap.

Rem Private Sub Workbook_Open()
Private Sub nyOrdre()
Dim ordreNr As String, sti, pw As String

    sti = ActiveWorkbook.Path & "\"
   
Rem henPW
    pw = ActiveWorkbook.BuiltinDocumentProperties("keywords")
Rem hent sidsteordrenr
    ordreNr = ActiveWorkbook.BuiltinDocumentProperties("subject")
Rem nyt ordrenr
    ordreNr = Format(CLng(ordreNr) + 1, "00000#")
Rem opdater OrdreNr
    ActiveWorkbook.BuiltinDocumentProperties("subject") = ordreNr
    ActiveWorkbook.Save
   
Rem fjern beskyttelse og indsæt ordrenr
    ActiveSheet.Unprotect pw
    Range("M16") = "Ordre." & ordreNr
Rem sæt beskyttelse igen
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
   
    If Sheets("ordre").Range("b17") = "" Then
        Sheets("ordre").Range("b17") = Date
    End If
   
Rem slet PW i ordre..
    ActiveWorkbook.BuiltinDocumentProperties("keywords") = ""
   
    ActiveWorkbook.SaveAs sti & "Ordre." & ordreNr & ".xls"
End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$C$6" Then
        Cancel = True
        nyOrdre
    End If
End Sub

Mange tak for hjælpen

Selv tak - en fornøjelse..