将BeforeDoubleClick_event的模块代码添加到动态创建的工作表中

Question

我有这段代码：

For a = 1 To 5
    strFoglio = "SheetName" & a
    Sheets.Add

    ActiveSheet.Name = strFoglio

    ActiveSheet.Move after:=Sheets(Sheets.Count)
Next a

有没有办法在这些全新的工作表上编写代码，例如：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    Dim myRange As Range
End sub

当然，我想直接在For...Next循环中进行，而不是手动进行。

Answer 1

下面的代码将运行您的For循环，创建5张，每张将调用Sub CodeCopy，它将从模块中复制代码行（在此示例中为“Sheet1”中的代码） ）进入新创建的工作表。

<强>代码

Option Explicit

Sub CreateSheets()

Dim a As Long

For a = 1 To 5
    Sheets.Add
    ActiveSheet.Name = "SheetName" & a
    ActiveSheet.Move after:=Sheets(Sheets.Count)
    Call CodeCopy(ActiveSheet.Name)
Next a

End Sub

' **********

Sub CodeCopy(DestShtStr As String)    

' Macro to copy the macro module from sheet1 to a new Sheet 
' Name of new sheet is passed to the Sub as a String
' Must install "Microsoft Visual Basic for Applications Extensibility library" 
' from Tools > References.

Dim i           As Integer
Dim SrcCmod     As VBIDE.CodeModule
Dim DstCmod     As VBIDE.CodeModule

' set source code module to code inside "Sheet1"
Set SrcCmod = ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Worksheets("Sheet1").CodeName).CodeModule
Set DstCmod = ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Worksheets(DestShtStr).CodeName).CodeModule

' copies all code line inside "Sheet1"
' can be modified to a constant number of code lines
For i = 1 To SrcCmod.CountOfLines
   DstCmod.InsertLines i, SrcCmod.Lines(i, 1)
Next i

End Sub

“ Sheet1 ”中的代码将复制到所有新创建的工作表：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim myRange As Range

End Sub

<强>说明

为了使此代码有效，您需要允许以下两件事：

1. 转到 工具 ＆gt;＆gt; 参考 ，并添加对“ Microsoft Visual Basic for Applications Extensibility ”库的引用（下面的屏幕截图）



1. 在Excel主菜单中，转到 开发者 菜单，然后选择 宏安全 ，点击 V 允许“信任访问VBA项目对象模型”（屏幕截图如下）

Answer 2

如果我理解，您希望直接在使用初始代码创建的新工作表上创建代码。

所以我会这样做：

Code(1) = Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Code(2) = Dim myRange As Range
Code(3) = '....

For i = 1 To 3
Wb.VBProject.VBComponents("SheetName & a").CodeModule.InsertLines i, Code(i)
Next i

（只是把它放在循环中）