Adding text to macro via macro

[wmtsub]

So I am using this code:

Sub insert()
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString ("Private Sub Workbook_BeforeSave ()")

ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString ("Cancel = True")

ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString ("Application.ThisWorkbook.Saved = True")

ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString ("End Sub")
End Sub

And I am getting this result:

Cancel = True
Application.ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_BeforeSave()

I can not get the private sub to print a the top of the list. I can change the order of all the other but this always goes to the bottom. And so it will not work.

Any idea why?
or a different way to do this?

-Eds

 

[footoo]

Sub insert()
Dim LineNum%
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
    LineNum = .CreateEventProc("BeforeSave", "Workbook")
    LineNum = LineNum + 1
    .InsertLines LineNum, "Cancel=true"
    LineNum = LineNum + 1
    .InsertLines LineNum, "Application.ThisWorkbook.Saved = True"
    LineNum = LineNum + 1
    .InsertLines LineNum, "end sub"
End With
End Sub

 

[Domenic]

You can use the CreateEventProc method to create any event procedure, such as BeforeSave...

Sub CreateBeforeSaveProcedure()

    Dim text As String
    Dim textLine As Long
    
    text = "ThisWorkbook.Saved = True"


    With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        textLine = .CreateEventProc("BeforeSave", "Workbook")
        .InsertLines textLine + 1, text
    End With
    
End Sub

Hope this helps!

 

[Domenic]

Sorry, for my solution, the text for the body of the event procedure should have been...

    text = "Cancel = True"
    text = text & vbCrLf & "ThisWorkbook.Saved = True"

 

[wmtsub]

Awesome thanks guys.

 

[wmtsub]

Over the week end I also found this to work.


Sheets("sheet1").Select
Sheets("sheet1").Copy
Application.WindowState = xlNormal
awn = ActiveWorkbook.Name
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 1, "Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)"
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 2, "Cancel = True"
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 3, "Application.ThisWorkbook.Saved = True"
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 4, "End Sub"

 

[wmtsub]

So to add purpose to this macro. I need to copy a worksheet to a new workbook and protect it so it can not be saved and also close the original workbook. I am hung up on the macro which only prints to the original workbook. I have tried to activated the new workbook but it does not seem to work. Any suggestions would be appreciated.

Sheets("sheets 1").Select
Sheets("sheets 1 ").Copy
Application.WindowState = xlNormal
awn = ActiveWorkbook.Name
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 1, "Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)"
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 2, "Cancel = True"
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 3, "Application.ThisWorkbook.Saved = True"
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 4, "End Sub"

 

[wmtsub]

found the issue. changed thisworkbook to active workbook and all is good.