vb代码win10正常运行win11出现1004报错

某个包被

一个刷表工具，在win10系统下可以正常运行，但是win11会出现

点击调试：

对比了两台电脑只发现了系统的版本不同，不确定是不是由于这个原因

代码如下：


Sub brushyourass3()

'————————added by jiamengnan 20210816
'- - - - - - - - - fixed by jiamengnan 20211229 解决删除行数据后的报错问题
'- - - - - - - - - - fixed by jiamengnan 20220317 解决删除行数据后输出页中之前的数据依然残留的问题
Dim i, j, k, m As Integer
Dim x, y As Integer
Dim z As Integer
Dim g As Integer
Dim apath, b As String
Dim transpath As String
Dim ownpath As String
Dim t
t = Timer
Application.ScreenUpdating = False
Excel.Application.Workbooks("item工具表.xlsm").Activate
Application.Worksheets("item").Activate
k = 0                                            '判断编辑页的item数
For i = 9 To 100000 Step 1
If Cells(i, 1) <> "" Then
k = k + 1
End If
Next i
Application.Worksheets("item_ex").Activate
m = 0                                           '判断数据页的item数
For j = 5 To 100000 Step 1
If Cells(j, 1) <> "" Then
m = m + 1
End If
Next j
y = 0
For x = 1 To 100 Step 1
If Cells(3, x) <> "" Then
y = y + 1
End If
Next x
Application.Worksheets("item").Activate
Cells(4, 3) = m
Cells(5, 3) = k
Cells(6, 3) = y
Worksheets("item").Calculate
Range("a" & 9 & ":a" & k + 8).Select
Selection.Copy
Application.Worksheets("item_ex").Activate
Range("a5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("b5").Resize(1, y).Select
Selection.Copy
For z = 6 To (k + 4) Step 1
Cells(z, 2).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next z
g = m - k
If g > 0 Then

Sheets("item_ex").Range("a" & (k + 5)).Resize(g, y).ClearContents

End If

Worksheets("item_ex").Calculate






'Application.CutCopyMode = False
Application.Worksheets("item").Activate

apath = Application.ActiveWorkbook.Path         '获取数据表路径
'Cells(4, 1) = apath
transpath = Left(apath, Len(apath) - 20)

ownpath = transpath & "trunk\public\config\Excel\Item"
Cells(1, 4) = ownpath

Application.DisplayAlerts = False
ActiveWorkbook.Save
b = Cells(1, 4)
Application.Worksheets("item").Activate
Application.Worksheets("item").Select


Worksheets("item").Calculate         '重新计算公式
Application.Worksheets("item_ex").Activate
Application.Worksheets("item_ex").Select
Worksheets("item_ex").Calculate
Range("a5").Resize(k, y).Select

Selection.Copy
Application.Workbooks.Open (b)
Application.Workbooks("Item.xlsx").Activate
Application.Worksheets("物品|Item").Activate
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False            '数值粘贴
Application.CutCopyMode = False            '清除剪贴板
Range("a" & (k + 5)).Resize(m, y).ClearContents
ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox ("本次刷表用时" & Format(Timer - t, "0.00" & "秒。别忘记SVN提交本表和Item表哦！"))

Application.ScreenUpdating = True


End Sub

andywangzian

应该是office的版本问题，也分32位和64位。跟系统版本问题不大。