I am writing some code in VBA that will use a single procedure to insert multiple commandbuttons onto the active worksheet. The user will click a form button on the sheet which, in turn, will generate two new buttons and their associated code lines in the worksheet code module.
The following code successfully generates the first commandbutton and its code lines:
Private Sub CreateAddSectionButton(B)
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oWS As Excel.Worksheet
Dim newButton As New OLEObject
Dim Code As String
Dim l As Long
Dim t As Long
'Fixed dimensions of the SLD sheet
Dim Header As Integer 'Rows above the Seg1 SLD
Dim H As Integer 'Height of the SLD box
Dim g As Integer 'Gap (in rows) between consecutive SLDs
Dim TopRow As Integer 'Top row number for the Segment
Header = 21
H = 17
g = 2
TopRow = Header + (H + g) * (B - 1) + 1
With Cells(TopRow, 2)
l = .Left
t = .Top
End With
'create button
Set oXL = Excel.Application
Set oWS = oXL.ActiveSheet
Set newButton = oWS.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, _
Left:=l + 10, Top:=t + 25, Width:=25, Height:=25)
newButton.Name = "AddSection" & B
'buttonn text
With oWS.OLEObjects("AddSection" & B).Object
.Caption = "+"
.BackColor = RGB(0, 0, 255)
.ForeColor = vbWhite
.Font.Name = "MS Sans Serif"
.Font.Size = 14
.Font.Bold = True
End With
Set newButton = Nothing
'macro text
Code = ""
Code = Code & "Private Sub AddSection" & B & "_Click()" & vbCrLf
Code = Code & "Call AddSection(" & B & ")" & vbCrLf
Code = Code & "End Sub"
'add macro at the end of the sheet module
Set oWB = oXL.ActiveWorkbook
With oWB.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.InsertLines .CountOfLines + 1, Code
End With
Code = vbNullString
End Sub
The above code is called from the following procedure:
Sub AddSegment_Click()
'...
Dim Segs As Integer
Dim B As Integer
Segs = Cells(3, 2).Value
B = Segs + 1
'...
CreateAddSectionButton (B)
CreateDeleteSectionButton (B)
End Sub
Excel crashes when I add the code for the CreateDeleteSectionButton(B):
Private Sub CreateDeleteSectionButton(B)
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oWS As Excel.Worksheet
Dim newButton As New OLEObject
Dim Code As String
Dim l As Long
Dim t As Long
'Fixed dimensions of the SLD sheet:
Dim Header As Integer 'Rows above the Seg1 SLD
Dim H As Integer 'Height of the SLD box
Dim g As Integer 'Gap (in rows) between consecutive SLDs
Dim TopRow As Integer 'Top row number for the Segment
Header = 21
H = 17
g = 2
TopRow = Header + (H + g) * (B - 1) + 1
With Cells(TopRow, 2)
l = .Left
t = .Top
End With
'create button
Set oXL = Excel.Application
Set oWS = oXL.ActiveSheet
Set newButton = oWS.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, _
Left:=l + 10, Top:=t + 75, Width:=25, Height:=25)
newButton.Name = "DeleteSection" & B
'buttonn text
With oWS.OLEObjects("DeleteSection" & B).Object
.Caption = "--"
.BackColor = RGB(0, 255, 0)
.ForeColor = vbWhite
.Font.Name = "MS Sans Serif"
.Font.Size = 14
.Font.Bold = True
End With
Set newButton = Nothing
'macro text
Code = ""
Code = Code & "Private Sub DeleteSection" & B & "_Click()" & vbCrLf
Code = Code & "Call DeleteSection(" & B & ")" & vbCrLf
Code = Code & "End Sub"
'add macro at the end of the sheet module
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.InsertLines .CountOfLines + 2, sCode
End With
Code = vbNullString
End Sub
As you can see, the code for CreateDeleteSectionButton is identical in form to the code for CreateAddSectionButton. But, for some reason, running the code a second time within the same subprocedure is making Excel suddenly shutdown. I read on the MS help site that the problem could be due to unqualified references, which is why I added the oXL, oWB and oWS prefixes. But that didn't fix the problem. I would greatly appreciate any help.
Bookmarks