Create New Worksheet Containing Buttons, not by template

[The_skinner]

Hello there,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I'm trying to create a macro that creates new worksheets with buttons on them that have macros attached. I've been able to produce one worksheet with a button and macro, but when the function that copies the code is looped it crashes out of Excel.<o></o>
<o></o>
I realise that the usual method of doing this would be by templates, but this code will be run on other people's computers so the template wouldn’t exist in the location that i had specified (I think with my limited experience with VBA - Please correct me if I'm wrong). I've also tried to copy the page with the button on, but this takes too long (even with screenupdating = false) as there are many sheets to be created.<o></o>
<o></o>
This is a stripped down version of the code that I have created for the purpose of this forum. To recap, the function that creates a new page, with button, with macro attached works. It's when it's looped that it crashes out. I've stepped through the program, and it reaches the second message box, then it gives up on life. <o></o>
<o></o>
I realise that financial incentives might be against this forum's code of conduct, but i will make an online donation to a charity of your choice if you can help me fix this code as it is making me hate life. <o></o>
<o></o>

Private Sub CommandButton1_Click()

Dim testvar As Boolean
Dim i As Integer
Dim continue As Boolean
continue = True
i = 1
Do Until continue = False 'loop until there's nothing in column A
  MsgBox "loop restarted"
 
  Sheets("Data").Select
  Worksheets.Add().Name = (i)
  testvar = copyheader(i)
  MsgBox "yeah!"
 
  If i >= 10 Then
      Exit Do
  End If
  i = i + 1
Loop
End Sub
Function copyheader(i As Integer) As Boolean
 
 
  Dim Name As String
  Dim NName As String
  Dim myCmdObj As OLEObject, N%
 
  Sheets(i).Select
 
  ' Set the name for the button
  NName = "cmdAction0"
 
   ' Add button
  Set myCmdObj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
  Link:=False, DisplayAsIcon:=False, Left:=146.25, Top:=1.5, _
  Width:=570, Height:=22.5)
 
   ' Define buttons name
  myCmdObj.Name = NName
 
   ' Define buttons caption
  myCmdObj.Object.Caption = "Click for action"
 
   ' Inserts code for the button
  With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
      N = .CountOfLines
      .InsertLines N + 1, "Private Sub cmdAction0_Click()"
      .InsertLines N + 2, "End Sub"
  End With
 
End Function

Thank-you for your time<o></o>
<o></o>

 

[The_skinner]

Probably best to go for top left.

 

[RoryA]

If you want it docked, set its Position property to msoBarTop.

 

[The_skinner]

I don't want to dock it as the user might not spot that it's there

Thanks

 

[RoryA]

It depends how precise you need to be (coordinates like this are a bit trickier than you might think). You can do something like:

    With cbrMenuBar
      .Enabled = True
      .visible = True
      .Position = msoBarTop
      sglTop = .Top
      .Position = msoBarFloating
      .Top = sglTop + 50
      .Left = 1
   End With

 

[The_skinner]

Hi again Rorya,

I've tried applying your code, but i get the error message "cannot apply to read only property" for .top and .left

Did it work on your machine?

Maybe its how I entered it into mine?:

Sub SetUpCbars()
   Dim ctl As CommandBarControl
   
   On Error Resume Next
   
   Set cbr = Application.CommandBars(gcstrAPP_NAME)
   If Not cbr Is Nothing Then cbr.Delete
   Set cbr = Application.CommandBars.Add(Name:=gcstrAPP_NAME, Position:=msoBarFloating, MenuBar:=False, temporary:=True)
   Set ctl = cbr.Controls.Add(Type:=msoControlButton)
   With ctl
      .Caption = "Return to Menu"
      .OnAction = "ReturntoMenu"
      .Style = msoButtonCaption
      .Enabled = True
      .Visible = True
      .Position = msoBarTop
      sglTop = .Top
      .Position = msoBarFloating
      .Top = sglTop + 50
      .Left = 1
      End With
   cbr.Visible = True
   cbr.Protection = msoBarNoChangeVisible

Have i put it in the wrong place?

 

[RoryA]

Yep! Those are properties of the commandbar, not the control you added. Try this:

Sub SetUpCbars()
   Dim ctl As CommandBarControl
   Dim strWBName As String
   strWBName = "'" & ThisWorkbook.Name & "'!"
   On Error Resume Next
   Set cbr = Application.CommandBars(gcstrAPP_NAME)
   If Not cbr Is Nothing Then cbr.Delete
   Set cbr = Application.CommandBars.Add(Name:=gcstrAPP_NAME, Position:=msoBarFloating, MenuBar:=False, temporary:=True)
   Set ctl = cbr.Controls.Add(Type:=msoControlButton)
   With ctl
      .Caption = "Return to Menu"
      .OnAction = strWBName & "ReturntoMenu"
      .Style = msoButtonCaption
   End With
   With cbr
      .Enabled = True
      .Visible = True
      .Position = msoBarTop
      sglTop = .Top
      .Position = msoBarFloating
      .Top = sglTop + 50
      .Left = 1
      .Protection = msoBarNoChangeVisible
   End With
End Sub

 

[The_skinner]

Haha! That's brilliant!

I have to say that you've lead me to create a much better program, with a professional feel to it. I've learned a tremendous amount about the workings of VBA too.

Now is there a charity you support?, as your advice has been excellent value and its time i paid it back

 

[RoryA]

Does my wife's shoe addiction count?
If you feel so inclined, feel free to make a contribution to the NSPCC with my thanks!

 

[The_skinner]

You could let her decide as a way of gauging how bad the problem is. Mind you, sounds like things have gotten pretty bad already!

The NSPCC it is, although i am intrigued to know how many pairs she has. My girl has 6 pairs which i consider excessive, how does that compare?

Thanks for all your help

 

[RoryA]

My wife has more than 6 pairs of flip-flops alone. She also takes at least 6 pairs of shoes if we go away for the weekend.