我有一个我编写的代码,它在excel 97中的电子表格中工作,但在2016年没有...代码意味着将数据表拆分为3个名为.....的部分。 _Haz1 ...... _ Haz2 ...... _ Haz3 .....
每列中的每个项目旁边都有复选框,这是一张风险评估表,当代码运行时,它应该将所有勾选的项目放在下面的表格中。
我已经创建了一个按钮并将宏连接到按钮上,所以当你点击按钮时它会运行那个特定的宏......
当我点击按钮时,它会运行它向下移动的代码,好像这些项目被放入下面的表格中但是我只是在表格中得到一条粗蓝线和ni项......
我感到困惑的是它在之前的excel 1997中有效,但在excel 2016中没有用
Option Explicit
Public iHazCount
Sub CompileHazards()
iHazCount = 0
Application.ScreenUpdating = False
Call ClearCompileArea
Call FetchHazards(Range("Hazards!Haz1"), -3)
Call FetchHazards(Range("Hazards!Haz2"), -4)
Call FetchHazards(Range("Hazards!Haz3"), -7)
' set print area
ActiveSheet.PageSetup.PrintArea = "$A$1:$Q$" & 80 + iHazCount
Application.Goto Reference:=Range("A91"), Scroll:=True
Application.ScreenUpdating = True
End Sub
Sub FetchHazards(rHazList As Range, iDataOffset As Integer)
Dim rHazCell As Range
Dim iCurrRow As Integer
For Each rHazCell In rHazList
If rHazCell.Value = True Then
' calculate row postion
iCurrRow = 81 + iHazCount
' first add line
' select bottom blank line and copy it down
Range("A" & iCurrRow & ":Q" & 82 + iHazCount).Select
Selection.Copy
Range("A" & iCurrRow + 1).Select
ActiveSheet.Paste
' go back to orig blank line and change blue bottom border
Range("A" & iCurrRow & ":Q" & iCurrRow).Select
Application.CutCopyMode = False
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' copy hazard
Range("A" & iCurrRow).Value = rHazCell.Offset(0, iDataOffset).Value
' insert risk formula
Range("P" & iCurrRow).Formula = "=IF(N" & iCurrRow & "*O" & iCurrRow & "< 7,""LOW"",IF(N" & iCurrRow & "*O" & iCurrRow & "< 11 ,""MID"",""HIGH""))"
' increment line count
iHazCount = iHazCount + 1
End If
Next
End Sub
Sub ClearCompileArea()
' delete all rows below first
Rows("83:121").Select
Selection.Delete Shift:=xlUp
' clear contents of first row
Range("A81:Q81").Select
Selection.ClearContents
' reinsert blue bottom border
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 5
End With
End Sub