|
现在出现的问题是,当改变号码中的数值,第一次会自动连线,左上角的控件不会被删除,但第二次改变数值情况下,会出现卡死现象,估计是代码的循环环节没有设置好,请大家帮忙解决下。
Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Or Target.Columns.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim nRow%, i%
Dim BeginR As Range, EndR As Range
nRow = Range("b500").End(xlUp).Row
Set BeginR = Range("c4").Offset(0, Range("b4"))
For Each c In ActiveSheet.Shapes
Set rng = c.TopLeftCell
If rng.Column > 1 And rng.Column < 50 And rng.Row > 1 And rng.Row < 500 Then
c.Delete
End If
Next
Range("C4:AJ" & nRow).FillDown
For i = 5 To nRow
Set EndR = Range("c" & i).Offset(0, Range("b" & i))
'绘制线条
Set DrawLine = Me.Shapes.AddLine(BeginR.Left + BeginR.Width / 2, _
BeginR.Top + BeginR.Height / 2, EndR.Left + EndR.Width / 2, _
EndR.Top + EndR.Height / 2).Line
Set BeginR = EndR
Next
ActiveSheet.DrawingObjects.ShapeRange.Group
With ActiveSheet.DrawingObjects.ShapeRange.Line
.DashStyle = msoLineSolid
.Weight = 1.3
.ForeColor.SchemeColor = 11
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
Set BeginR = Nothing
Set EndR = Nothing
End Sub
[ 本帖最后由 wlj19790204 于 2010-9-3 16:56 编辑 ] |
|