[已解决]请大师帮忙编个程序能自动画线条

QCLi

请大师帮忙编个程序能自动画线条，不要格式那种。根据E列开始时间和F列结束时间在H-AL列自动画线条。见下图：

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-6-11 14:50

1. Sub 画线()
   
2.     Dim x As Double, x1 As Double, y As Double, n&, i&, d1%, d2%
   
3.     With Sheet1
   
4.         n = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
   
5.         .DrawingObjects.Delete
   
6.         For i = 5 To n
   
7.             d1 = Day(.Range("E" & i))
   
8.             d2 = Day(.Range("F" & i))
   
9.             x = .Cells(i, d1 + 7).Left
   
10.             y = .Cells(i + 1, d1 + 7).Top - .Cells(i + 1, d1 + 7).Height / 2
    
11.             x1 = .Cells(i, d2 + 8).Left
    
12.             .Shapes.AddConnector(msoConnectorStraight, x, y, x1, y).Select
    
13.             With Selection.ShapeRange.Line
    
14.                 .ForeColor.RGB = RGB(0, 0, 0)
    
15.                 .Weight = 6
    
16.             End With
    
17.         Next
    
18.     End With
    
19. End Sub

复制代码

跳转到最佳答案楼层

老司机带带我

1. Sub 画线()
   
2.     Dim x As Double, x1 As Double, y As Double, n&, i&, d1%, d2%
   
3.     With Sheet1
   
4.         n = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
   
5.         .DrawingObjects.Delete
   
6.         For i = 5 To n
   
7.             d1 = Day(.Range("E" & i))
   
8.             d2 = Day(.Range("F" & i))
   
9.             x = .Cells(i, d1 + 7).Left
   
10.             y = .Cells(i + 1, d1 + 7).Top - .Cells(i + 1, d1 + 7).Height / 2
    
11.             x1 = .Cells(i, d2 + 8).Left
    
12.             .Shapes.AddConnector(msoConnectorStraight, x, y, x1, y).Select
    
13.             With Selection.ShapeRange.Line
    
14.                 .ForeColor.RGB = RGB(0, 0, 0)
    
15.                 .Weight = 6
    
16.             End With
    
17.         Next
    
18.     End With
    
19. End Sub

复制代码

02761752696