Vba Excel Add.xlam模块将代码注入新工作表

我有一个模块正在创建一个工作表。它构建了一个包含一系列表的工作表

我想添加一个特性，它使用单元格的OnChange事件来验证用户是否输入了十进制数。如果我可以插入到新的工作表中，下面的代码就可以做到这一点。这是我唯一搞不懂的事

给定的“s”是我们刚刚创建的当前工作表，是否有任何方法将以下代码注入到“s”的工作表代码模块中

Private Sub Worksheet_Change(ByVal Target As Range)
Const CELL_ADDRESS = "$R$4:$AQ$500" 
If Not Application.Intersect(Target, Range(CELL_ADDRESS)) Is Nothing Then
   If Not IsNumeric(Target.Value) Then
      MsgBox "Please enter numbers only", vbCritical, "Invalid Entry"
      Target.Value = vbNullString
   End If
End If 
End Sub

---

编辑：显示所选的问题解决方案（选择Wedge的解决方案）

（答：）我们将向加载项中添加一个公共函数，我们将从模板中调用该函数，从而从模板中创建所有工作表

使用模板并复制它将允许我们将自定义代码构建到新的工作表中，而无需更改安全设置

调用公共函数允许我们对工作表进行修改，而无需将受保护的密码放入工作表的代码中

（表中的公共函数调用）

（加载项中内置的公共函数，当用户修改数据时，工作表将调用该函数。）

--这个函数所做的就是确保我们的单元格只将数字存储为数字和格式。单元格中的任何非值文本都将变为0。即使用户副本粘贴了数据，也可以这样做

Public Function Validate_Input(wb As Workbook, ws As Worksheet, r As Range)
    CELL_ADDRESS = Cells(1, 2).Value ''''we'll use the locked Cell B1 to specify the Validation Range
    Dim rCell As Range
    Dim eCell As Range
    Dim numErr As Boolean

    numErr = False

    Set rCell = Range(CELL_ADDRESS)


    If Not Application.Intersect(rCell, r) Is Nothing Then
       ActiveSheet.Protect Password:="pw", UserInterfaceOnly:=True
       Application.EnableEvents = False
       For Each eCell In rCell.Cells
           If Not eCell Is Nothing And eCell.Locked = False And Not Application.Intersect(eCell, r) Is Nothing Then
              If IsNumeric(eCell.Value) = False Or IsEmpty(eCell.Value) = True Or eCell.Value <> eCell.Value + "0" Then
                 If Not IsNumeric(eCell.Value) Then
                    numErr = True
                 End If
                       eCell.Value = Val(eCell.Value)
              End If
                 eCell.Interior.Color = RGB(255, 255, 153)
                 eCell.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* "" - ""??_);_(@_)"
              If eCell.Value > 1000000 Then
                 eCell.Columns.AutoFit
                 eCell.ColumnWidth = eCell.ColumnWidth * 1.2
              End If
          End If
       Next eCell
       Application.EnableEvents = True
       ActiveSheet.Protect Password:="pw", UserInterfaceOnly:=False
    End If

    If numErr = True Then
       MsgBox "Only numbers are allowed here.", vbCritical, "Invalid Entry"
    End If

End Function

公共函数验证\u输入（wb作为工作簿，ws作为工作表，r作为范围）
CELL_ADDRESS=单元格（1，2）。值“”，我们将使用锁定的单元格B1指定验证范围
变暗rCell As范围
Dim eCell As范围
作为布尔值的Dim numer
numer=False
设置rCell=范围（单元格地址）
如果不是，则Application.Intersect（rCell，r）什么都不是
ActiveSheet.Protect密码：=“pw”，UserInterfaceOnly:=True
Application.EnableEvents=False
对于rCell.单元格中的每个eCell
如果Not eCell为Nothing，eCell.Locked=False，而不是Application.Intersect（eCell，r）则为Nothing
如果IsNumeric（eCell.Value）=False或IsEmpty（eCell.Value）=True或eCell.Value eCell.Value+“0”，则
如果不是数字（eCell.Value），则
数值=真
如果结束
eCell.Value=Val（eCell.Value）
如果结束
eCell.Interior.Color=RGB（255、255、153）
eCell.NumberFormat=“（*，##########(，######0）；（*-"########0）
如果eCell.值>1000000，则
eCell.Columns.AutoFit
eCell.ColumnWidth=eCell.ColumnWidth*1.2
如果结束
如果结束
下埃塞尔
Application.EnableEvents=True
ActiveSheet.Protect密码：=“pw”，UserInterfaceOnly:=False
如果结束
如果numer=True，则
MsgBox“此处仅允许数字”，vbCritical，“无效条目”
如果结束
端函数

这不完全是您所要求的，但我认为您可以创建一个隐藏的“模板”工作表，其中包含您想要的代码（有一个xlVeryHidden选项可用于防止模板工作表从UI中隐藏）。然后，您不必创建新工作表，而是创建该“模板工作表”的副本，它应该复制工作表上的VBA代码。

这不完全是您要求的，但我认为您可以创建一个隐藏的“模板”工作表，其中包含您想要的代码（有一个xlVeryHidden选项，您可以使用它来防止模板工作表从UI中被隐藏）。然后，不创建新工作表，而是创建“模板工作表”的副本，该副本应复制到工作表VBA代码上。

首先，您必须在信任中心启用“信任访问VBA项目对象模型”设置。
在那之后，你必须写这样的东西：

Sub AddModule()
    Dim Module As VBComponent
    Dim ModuleString As String

    ModuleString = "Sub Test()" & vbCrLf & _
                   "    Msgbox(""Test"")" & vbCrLf & _
                   "End Sub"

    Set Module = Workbooks(2).VBProject.VBComponents.Add(vbext_ct_StdModule)
    Module.CodeModule.AddFromString ModuleString

End Sub

---

显然，您必须更改工作簿引用和ModuleString。另外，请注意信任更改。这是有原因的。

首先，您必须在信任中心启用“信任访问VBA项目对象模型”设置。
在那之后，你必须写这样的东西：

Sub AddModule()
    Dim Module As VBComponent
    Dim ModuleString As String

    ModuleString = "Sub Test()" & vbCrLf & _
                   "    Msgbox(""Test"")" & vbCrLf & _
                   "End Sub"

    Set Module = Workbooks(2).VBProject.VBComponents.Add(vbext_ct_StdModule)
    Module.CodeModule.AddFromString ModuleString

End Sub

---

显然，您必须更改工作簿引用和ModuleString。还必须小心信任更改。这是有原因的。

不要忘记，

Target

并不总是一个单单元格范围：它可以是整行/列，或其他用户选择的范围。在这些情况下，您的代码将出错，因为

Target.Value

将是一个二维数组，而不是单个值。不要忘记，

Target

并不总是一个单单元格范围：它可以是一整行/列，或其他用户选择的范围。在这些情况下，您的代码将出错，因为

Target.value

将是一个二维数组，而不是单个值。我使用了此方法，因此我们没有启用“对VBA项目模型的信任访问”非常有效。我使用了此方法，因此我们不必启用“对VBA项目模型的信任访问”。非常有效。