动态新建sheet，单元格内容变化事件

yf_992258

当前sheet，知道可以使用Worksheet_Change来触发，或者加一个commandbutton。但是sheet比较多，不可能每个sheet都手动加一遍。


比如动态新建sheets.add后，新建的sheet中如何修改单元格让Worksheet_Change来触发（注：新建的格式都一样）

蓝桥玄霜

可以用Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

arsong

用类模块做比较好吧，我自己也不会

yf_992258

蓝桥玄霜 发表于 2023-1-6 13:39
可以用Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

版主可否给个实例

yf_992258

网上找了个例子，貌似可行，就是有点问题不会改，请各位指点一下
以下标红颜色的地方，我想改成新建的sheet名为test的增加，这里变量怎么改

Dim ws As Worksheet
Set ws = Sheets.Add
ws.Name = "test"
With ThisWorkbook.VBProject.VBComponents("Sheet2").CodeModule
.InsertLines 1, "Private Sub Worksheet_Change(ByVal Target As Range)"
.InsertLines 2, "  msgbox ""ok!"""
.InsertLines 3, "End sub"
End With

yf_992258

查了一下，改成以下红色字体即可
Dim ws As Worksheet
Set ws = Sheets.Add
ws.Name = "test"
With ThisWorkbook.VBProject.VBComponents(ws.CodeName).CodeModule
.InsertLines 1, "Private Sub Worksheet_Change(ByVal Target As Range)"
.InsertLines 2, "  msgbox ""ok!"""
.InsertLines 3, "End sub"
End With

taller

yf_992258

taller 发表于 2023-1-7 05:32

谢谢版主，测试了一下，可行。

另外一个问题再请教一下，目的是每个新建表格的L列的单元格有变动，同sheet中对应A列的编码相同的也同步变动。因为各sheet有若干公式，所以我本意是想改成手动计算，替换单元格内容后再改回自动，结果报错，注释掉正常。
因为
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

hs = Target.Row
If Target.Column = 12 And hs > 22 Then
'Application.Calculation = xlManual '-----------加了这句就报溢出堆栈空间错误
lr = Range("a" & Rows.Count).End(xlUp).Row
bm = Sh.Cells(hs, 1)
dm = Sh.Cells(hs, 12)
For i = 23 To lr
If hs <> i Then
If UCase(CStr(Sh.Cells(i, 1))) = UCase(CStr(bm)) Then Sh.Cells(i, 12) = dm
End If
Next
'Application.Calculation = xlAutomatic
End If

End Sub

yf_992258

另外还有个问题，使用插入VBE代码的

With ThisWorkbook.VBProject.VBComponents(ws.CodeName).CodeModule
if Not .Find("Worksheet_Change", 1, 1, -1, -1) Then'----------------------------这个也是网上摘过来的，但是这个find无效，插入不了，不报错，请教是什么情况。去掉这个判断可以正常插入，不过多次插入肯定有重复报错了，所以要增加一个判断

  .InsertLines 1, "Private Sub Worksheet_Change(ByVal Target As Range)"
  .InsertLines 2, "  msgbox ""ok!"""
  .InsertLines 3, "End sub"
End if

End With