Hej CADmager,
Her er det meste af hele det der foregår - det er ikke noget jeg helt selv har lavet - men fået noget forærende og brygget videre på funktionerne. Det virker ellers fint og gør hvad det skal.
Starten på Privat Sub indeholder ikke andet end et chek på om de felter i min Form er udfyldt / ændret.
Bliver du klogere af dette ?
'Skriver i Sagsnotatregister
Workbooks.Open CurDir & "\Dok\05 Korrespondance\05-03 Arkitekt\Sagsnotater\Sagsnotatregister.xls", , False, , , "vl"
With Worksheets("Sagsnot-reg")
For I = 1 To 1000
If (.Cells(I + 5, 1) = "") Then
notnr.Text = Format((.Cells(I + 4, 1) + 1), "0##")
.Cells(I + 5, 1) = notnr.Text
.Cells(I + 5, 2) = Dato.Text
If (Referat.Value) Then
.Cells(I + 5, 3) = ("Referat : " & Emne.Text)
Else
.Cells(I + 5, 3) = ("Notat : " & Emne.Text)
End If
'.Cells(I + 5, 3) = Emne.Text
.Cells(I + 5, 4) = Excel.Application.UserName
'INI = Excel.Application.UserName
Exit For
End If
Next I
End With
ActiveWorkbook.Close Savechanges:=True
Excel.Application.Quit
'Skriver i Dokumentregister
Dato1.Text = Format(Date, "dd.mm.yy")
Workbooks.Open CurDir & "\Dok\01 Sagsbasis\01-01 Sagsregistrering\Dokumentregister.xls", , , , , "vl"
With Worksheets("DOKU-reg")
For I = 1 To 500
If (.Cells(I + 6, 1) = BLANK) Then
løbenr.Text = Format((.Cells(I + 5, 1) + 1), "0##")
.Cells(I + 6, 1) = løbenr.Text
.Cells(I + 6, 2) = Dato1.Text
'.Cells(I + 6, 4) = "x"
'.Cells(I + 6, 5) = Til.Text
.Cells(I + 6, 6) = "05-03"
.Cells(I + 6, 7) = "SNotat"
If (Referat.Value) Then
.Cells(I + 6, 8) = (notnr.Text & " - Referat : " & Emne.Text)
Else
.Cells(I + 6, 8) = (notnr.Text & " - Notat : " & Emne.Text)
End If
.Cells(I + 6, 9) = Excel.Application.UserName
Exit For
End If
Next I
End With
ActiveWorkbook.Close Savechanges:=True
Excel.Application.Quit
Dim wordapp As Application
Dim doc As Document
'Dim Sagsnavn As String
'Dato.Text = Format(Date, "dd.mm.yyyy")
Set wordapp = CreateObject("Word.Application")
If (Referat.Value) Then
If (snotnr.Text = "000") Then
FileCopy "Y:\VL Arkiv og dok\SAGSNOTAT Master ref.doc", CurDir & "\Dok\05 Korrespondance\05-03 Arkitekt\Sagsnotater\Sagsnotat " & notnr.Text & ".doc"
'FileCopy ".\SAGSNOTAT Master ref.doc", CurDir & "\Dok\05 Korrespondance\05-03 Arkitekt\Sagsnotater\Sagsnotat " & notnr.Text & ".doc"
Else
FileCopy CurDir & "\Dok\05 Korrespondance\05-03 Arkitekt\Sagsnotater\Sagsnotat " & snotnr.Text & ".doc", CurDir & "\Dok\05 Korrespondance\05-03 Arkitekt\Sagsnotater\Sagsnotat " & notnr.Text & ".doc"
End If
Else
FileCopy "Y:\VL Arkiv og dok\SAGSNOTAT Master not.doc", CurDir & "\Dok\05 Korrespondance\05-03 Arkitekt\Sagsnotater\Sagsnotat " & notnr.Text & ".doc"
'FileCopy ".\SAGSNOTAT Master not.doc", CurDir & "\Dok\05 Korrespondance\05-03 Arkitekt\Sagsnotater\Sagsnotat " & notnr.Text & ".doc"
End If
Set doc = wordapp.Documents.Open(CurDir & "\Dok\05 Korrespondance\05-03 Arkitekt\Sagsnotater\Sagsnotat " & notnr.Text & ".doc")
Word.Application.Documents.Open (CurDir & "\Dok\05 Korrespondance\05-03 Arkitekt\Sagsnotater\Sagsnotat " & notnr.Text & ".doc")
Word.Application.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.TypeText (Sagsnavn.Text)
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.TypeText (Sag.Text)
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.TypeText ("Sagsnotat " & notnr.Text)
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.TypeText (Emne.Text)
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.TypeText (Dato.Text)
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.TypeText (Application.UserInitials)
Word.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.TypeText (Emne.Text)
Word.Application.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Word.Selection.MoveRight Unit:=wdCell
Word.Selection.MoveLeft Unit:=wdCell
Word.Selection.TypeText (Sag.Text & "-" & løbenr.Text)
doc.SaveAs CurDir & "\Dok\05 Korrespondance\05-03 Arkitekt\Sagsnotater\Sagsnotat " & notnr.Text & ".doc"
Word.Application.Quit
Opret.Enabled = False
Aabn.Enabled = True
End Sub