sorry Bob, I pasted your solution into my code, but there is an reaso
why it doesn't work. I worked a couple of houres on it, but no result
Only errorrs. Here my code:
Function CreateNewWorkbook(Optional intNumberSheets As Integer = 1) A
Workbook
Dim wkbNew As Excel.Workbook
On Error GoTo CreateNewWorkbook_Err
Set wkbNew = Workbooks.Add
Set CreateNewWorkbook = wkbNew
Application.SheetsInNewWorkbook = intNumberSheets

'Isert Event procedure of Bob
AddWorkbookEventProc

CreateNewWorkbook_End:
Exit Function

CreateNewWorkbook_Err:
Set CreateNewWorkbook = Nothing
wkbNew.Close savechanges:=False
Set wkbNew = Nothing
Resume CreateNewWorkbook_End
End Function

Sub AddWorkbookEventProc()
Dim StartLine As Long
With ActiveWorkbook.VBProject.VBComponents("ThisWorkboo k").CodeModule
StartLine = .CreateEventProc("BeforeSave", "Workbook") + 1
.InsertLines StartLine, _
"Dim ans" & vbCrLf & _
" ans = Msgbox( ""All OK"",vbOYesNo)" & vbCrLf & _
" If ans = vbNo Then Cancel = True"
End With

End Sub

'''Activeworkbook.vbproject. etc etc gives always an erro

--
Message posted from http://www.ExcelForum.com