On 2002-04-25 01:56, richey wrote:
Hi
I have some code running on the BeforeDoubleClick of a Worksheet
I have some code which adds a new sheet etc, which is great but it doesn't copy the code for BeforeDoubleClick across to the new sheet?
any help much appreciated
Hi Richie
This is how I have done similar in the past.
See if you can adapt it. The key is in your
Double click code...you will have o hard
code this in using my example.
<pre/>
Option Explicit
Sub CreateSheet_DblCk_Event()
Add_Sheet
Add_DblClick_To_CodeMod
End Sub
Sub Add_Sheet()
On Error Resume Next
Tryagain:
Sheets.Add
If Err <> 0 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
GoTo Tryagain
End If
On Error GoTo 0
Application.EnableEvents = True
End Sub
Sub Add_DblClick_To_CodeMod()
Dim ModEvent As CodeModule 'Module to Modified
Dim LineNum As Long 'Line number in module
Dim SubName As String 'Event to change as text
Dim Proc As String 'Procedure string
Dim EndS As String 'End sub string
Dim Ap As String 'Apostrophe
Dim Tabs As String 'Tab
Dim LF As String 'Line feed or carriage return
Dim newShCodeNm 'Newsheet code name
Dim oWks As Worksheet
Set oWks = ThisWorkbook.ActiveSheet
Ap = Chr(34)
Tabs = Chr(9)
LF = Chr(13)
EndS = "End Sub"
'// Get Code name of sheet
Set newShCodeNm = oWks.Parent.VBProject.VBComponents(oWks.CodeName).Properties("_CodeName")
'// Your Event Procedure OR SubRoutine
SubName = "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range," _
& "Cancel As Boolean)" & LF
'// Your Procedure
Proc = "If Range(" & Ap & "A1" & Ap & " ) = 1 Then" & LF
Proc = Proc & Tabs & "MsgBox " & Ap & "Testing number =" & Ap & _
"& Range(" & Ap & "A1" & Ap & ")" & LF
Proc = Proc & "End If" & LF
'// Use ThisWorkbook so that it cannot Act on another workbook
Set ModEvent = ThisWorkbook.VBProject.VBComponents(newShCodeNm).CodeModule
With ModEvent
LineNum = .CountOfLines + 1
.InsertLines LineNum, SubName & Proc & EndS
End With
End Sub
</pre>