Thanks Thanks:  0
Likes Likes:  0
Results 1 to 2 of 2

Thread: copy code across to new sheet

  1. #1
    New Member
    Join Date
    Feb 2002
    Location
    Manchester, England
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  2. #2
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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.


    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



    Kind Regards,
    Ivan F Moala From the City of Sails

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •