making new wkb and place an event in it

O

Olaerts Ludo

I' am starting from an open excel work- book a code. This cod
contents:
Step 1: I would add a new workbook
Step 2: I would insert a commandbutton on sheet(1) that listen to
code (e.g. a msgBox)
Step 3: I want to include a event workbook_beforeSaved (e.g. a msgBox)
Is it possible to write one code in the open workbook that do thos
things
I have made step 1 succesfully:
Function CreateNewWorkbook(Optional intNumberSheets As Integer = 1
As Workbook
Dim wkbNew As Excel.Workbook

On Error GoTo CreateNewWorkbook_Err

Set wkbNew = Workbooks.Add
Set CreateNewWorkbook = wkbNew
Application.SheetsInNewWorkbook = intNumberSheets

CreateNewWorkbook_End:
Exit Function

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

Bob Phillips

Code for Step 3

Sub AddWorkbookEventProc()
Dim StartLine As Long

With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").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


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
O

Olaerts Ludo

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("ThisWorkbook").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
 
B

Bob Phillips

Hi Olaerts,

I have just copied your whole code across, and apart from having to change
this line
InsertLines StartLine, _
to
..InsertLines StartLine, _
which is a problem with ExcelForum I think, it worked perfectly, and I ended
up with this code in ThisWorkbook.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim ans
ans = MsgBox("All OK", vbOYesNo)
If ans = vbNo Then Cancel = True

End Sub


Just a thought. Do you have a language version of Excel?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
O

Olaerts Ludo

Hi Bob, frustrated, but doesn't work.
I live in Belgium, speak Dutch. I write a code in English. Helpfiles a
dutch. If I look in the configaration window --> country configuration
it is Nederland(Belgie)-

Current Location = Belgie

Tabblad Advanced = Language for not unicode compatible = Englis
(United states)

I also have market in Visual basic edito
-->extra-->reference-->microsoft VBA Extensibility library

In the code it is unpossible to place two dots before insertlines

Error message = Fout 1004 tijdens uitvoeren methode VBProject va
object_Workbook is mislukt
Error 1004 on running Method VBProject of object_Workbook is failled

Thanks for helping
Lud
 
B

Bob Phillips

Ludo,

I am not seeing the problem.

I don't know if this will work, but you could try sending the workbook to
me, and I will see if I can fix it.

Mail to

bob . phillips @ tiscali . co . uk

no spaces

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Top