Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/24.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba 将BeforeDoubleClick\u事件的模块代码添加到动态创建的工作表中_Vba_Excel_Macros - Fatal编程技术网

Vba 将BeforeDoubleClick\u事件的模块代码添加到动态创建的工作表中

Vba 将BeforeDoubleClick\u事件的模块代码添加到动态创建的工作表中,vba,excel,macros,Vba,Excel,Macros,我有以下代码: 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

我有以下代码:

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
循环中执行,而不是手动执行。

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

所以我想这样做:

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

(只需将其放入循环中)

下面的代码将运行
For
循环,创建5张工作表,每张工作表将调用
子CodeCopy
,该子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
将复制到所有新创建图纸的“图纸1”中的代码为:

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

    Dim myRange As Range

End Sub

说明

为了使此代码正常工作,您需要允许以下两件事:

  • 转到工具>参考,并添加对“Microsoft Visual Basic for Applications Extensibility”库的参考(下面的屏幕截图)
  • 在Excel主菜单中,转到开发者菜单,然后选择宏安全性,点击V,允许“信任访问VBA项目对象模型”(下面的屏幕截图)

  • 双击前查看
    工作簿
    事件名为
    工作簿_sheet
    -如果您对其进行编码,则无需为动态添加到工作簿中的每张工作表编写单独的事件处理程序。@Sergio Obici检查下面我的答案,如果您想给出这个答案,请告诉我它是否适用于您应至少引用
    code
    数组中的值,例如
    code(1)=“Dim foo As String”
    。否则,您的示例代码将无法编译,某个地方的某个人应该投票否决您的答案……谢谢,不幸的是,它返回了一个运行时错误1004。我可以修改我的设置来修复它,但是这个文件应该在几台电脑上运行,我不能要求每个人都管理设置。我会回到旧的想法,复制一个隐藏的表单,上面已经写了代码。谢谢你的建议。你的主意很好,塞吉奥,我觉得更安全。