Hello Geoff,
Sorry to keep you waiting. I completely rewrote the macros. It should be easier and faster to do your coding now. All the code resides in two modules: a Standard Module and a Class Module. Once you add a new button, you only need to add it to the command button setup list module. The entry lines must be to the left of the button, and the line color must be the yellow that you used, which has a color index of 36. Everything has been added to the attached workbook.
CmdBtnClass Class Module
This customizes the ActiveX (Control Toolbox) added to the workbook to simplify adding lines to the worksheets. After adding a new Class Module to your project, rename it CmdBtnClass.
'Written: November 25, 2007
'Author: Leith Ross
'Summary: Custom CommandButton Class
Private WithEvents MSCmdBtn As MSForms.CommandButton
'----------------------------------------'
' Private Class Variables and Objects '
'----------------------------------------'
Dim pvtButtonName As String
Dim pvtWorksheetName As String
Dim pvtHasHeaderRow As Boolean
Dim oleCmdBtn As OLEObject
'----------------------------------------'
' Read/Write Properties '
'----------------------------------------'
Public Property Let ButtonName(Button_Name As String)
pvtButtonName = Button_Name
End Property
Public Property Get ButtonName() As String
ButtonName = pvtButtonName
End Property
Public Property Let Caption(Caption_Text As String)
MSCmdBtn = Caption_Text
End Property
Public Property Get Caption() As String
Caption = MSCmdBtn.Caption
End Property
Public Property Let HasHeaderRow(Has_Header_Row As Boolean)
pvtHasHeaderRow = Has_Header_Row
End Property
Public Property Get HasHeaderRow() As Boolean
HasHeaderRow = pvtHasHeaderRow
End Property
Public Property Let Height(Height As Double)
oleCmdBtn.Height = Height
End Property
Public Property Get Height() As Double
Height = oleCmdBtn.Height
End Property
Public Property Let Left(Left As Double)
oleCmdBtn.Left = Left
End Property
Public Property Get Left() As Double
Left = oleCmdBtn.Left
End Property
Public Property Let Top(Top As Double)
oleCmdBtn.Top = Top
End Property
Property Get Top() As Double
Top = oleCmdBtn.Top
End Property
Public Property Let Visible(State As Boolean)
oleCmdBtn.Visible = State
End Property
Public Property Get Visible() As Boolean
Visible = oleCmdBtn.Visible
End Property
Public Property Let Width(Width As Double)
oleCmdBtn.Width = Width
End Property
Public Property Get Width() As Double
Width = oleCmdBtn.Width
End Property
Public Property Let WorksheetName(Worksheet_Name As String)
pvtWorksheetName = Worksheet_Name
End Property
Public Property Get WorksheetName() As String
WorksheetName = pvtWorksheetName
End Property
'----------------------------------------'
' Read Only Properties '
'----------------------------------------'
Public Property Get BottomRightCell() As Range
Set BottomRightCell = oleCmdBtn.BottomRightCell
End Property
Public Property Get OLEIndex() As Long
OLEIndex = oleCmdBtn.Index
End Property
Public Property Get OLEType() As Variant
OLEType = oleCmdBtn.OLEType
End Property
Public Property Get TopLeftCell() As Range
Set TopLeftCell = oleCmdBtn.TopLeftCell
End Property
'----------------------------------------'
' Methods '
'----------------------------------------'
Public Sub Activate()
Set oleCmdBtn = Worksheets(pvtWorksheetName).OLEObjects(pvtButtonName)
Set MSCmdBtn = oleCmdBtn.Object
End Sub
Public Function Copy()
oleCmdBtn.Copy
End Function
Public Function Cut()
oleCmd.Cut
End Function
'----------------------------------------'
' Event Procedures '
'----------------------------------------'
Private Sub Class_Terminate()
Set MSCmdBtn = Nothing
End Sub
Private Sub MSCmdBtn_Click()
Dim C As Long
Dim N As Long
Dim R As Long
With MSCmdBtn
C = .TopLeftCell.Column - 1
R = .TopLeftCell.Row
If pvtHasHeaderRow = True Then R = R + 1
End With
'Count the pale yellow lines
Do While Cells(R + N, C).Interior.ColorIndex = 36
N = N + 1
Loop
If N <> 0 Then
Cells(R + N, "A").EntireRow.Insert
Cells(R + N - 1, "A").EntireRow.Copy
Cells(R + N, "A").PasteSpecial
Application.CutCopyMode = False
End If
End Sub
Setup Command Buttons
After you add a button to a worksheet you will need to add a reference to that button this module. This creates a new custom command button that will automatically add lines when clicked. The row of the first entry line is the row of the upper left corner that the button is in. This first row can be a header row. If it is you need to set the HasHeaderRow property to True. The Default is False. You will see examples of this in the module code.
Dim CmdBtn1 As New CmdBtnClass
Dim CmdBtn2 As New CmdBtnClass
Dim CmdBtn3 As New CmdBtnClass
Dim CmdBtn4 As New CmdBtnClass
Dim CmdBtn5 As New CmdBtnClass
Sub SetupCommandButtons()
With CmdBtn1
.ButtonName = "CommandButton1"
.HasHeaderRow = True
.WorksheetName = "Operation"
.Activate
End With
With CmdBtn2
.ButtonName = "CommandButton2"
.HasHeaderRow = True
.WorksheetName = "Operation"
.Activate
End With
With CmdBtn3
.ButtonName = "Chronology"
.HasHeaderRow = False
.WorksheetName = "Chronology"
.Activate
End With
With CmdBtn4
.ButtonName = "GenObservations"
.HasHeaderRow = False
.WorksheetName = "Chronology"
.Activate
End With
With CmdBtn5
.ButtonName = "Observation"
.HasHeaderRow = False
.WorksheetName = "Chronology"
.Activate
End With
End Sub
This macro macro is also called by the Workbook_Open() and Workbook_BeforeSave() events. If for some reason the buttons stop working, run this macro.
Sincerely,
Leith Ross
Bookmarks