|
Sub add()
Sheet1.Unprotect "123456"
Dim K, K1, I As Integer
Dim A, B, C, D As Single
For K = 4 To Sheet1.[a65536].End(xlUp).Row
If Cells(K, 39) = "" Then '百位
For I = 6 To 15
If Cells(K, I) <> "" Then
C = Cells(K, I).Column
D = Cells(K, I).Row
C = ((C - 5) * 20 + 110) * 0.75
D = (D - 3) * 15 + 52.5
End If
Next
If K <> 4 Then '来取得起点
K1 = K - 1
For I = 6 To 15
If Cells(K1, I) <> "" Then
A = Cells(K1, I).Column
B = Cells(K1, I).Row
A = ((A - 5) * 20 + 110) * 0.75
B = (B - 3) * 15 + 52.5
End If
Next
End If
Sheet1.Shapes.AddLine(A, B, C, D).Select '坐标(A=?,B=列高1 ,C=?,D=列高2),像数转高度公式:像数*0.75
Selection.ShapeRange.Line.Weight = 1.5 '粗细
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 '颜色
A = 0
B = 0
C = 0
D = 0
'********************************************十位
For I = 17 To 26
If Cells(K, I) <> "" Then
C = Cells(K, I).Column
D = Cells(K, I).Row
C = ((C - 16) * 20 + 320) * 0.75
D = (D - 3) * 15 + 52.5
End If
Next
If K <> 4 Then '来取得起点
K1 = K - 1
For I = 17 To 26
If Cells(K1, I) <> "" Then
A = Cells(K1, I).Column
B = Cells(K1, I).Row
A = ((A - 16) * 20 + 320) * 0.75
B = (B - 3) * 15 + 52.5
End If
Next
End If
Sheet1.Shapes.AddLine(A, B, C, D).Select '坐标(A=?,B=列高1 ,C=?,D=列高2),像数转高度公式:像数*0.75
Selection.ShapeRange.Line.Weight = 1.5 '粗细
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 '颜色
A = 0
B = 0
C = 0
D = 0
'******************************************个位
For I = 28 To 37
If Cells(K, I) <> "" Then
C = Cells(K, I).Column
D = Cells(K, I).Row
C = ((C - 27) * 20 + 530) * 0.75
D = (D - 3) * 15 + 52.5
End If
Next
If K <> 4 Then '来取得起点
K1 = K - 1
For I = 28 To 37
If Cells(K1, I) <> "" Then
A = Cells(K1, I).Column
B = Cells(K1, I).Row
A = ((A - 27) * 20 + 530) * 0.75
B = (B - 3) * 15 + 52.5
End If
Next
End If
Sheet1.Shapes.AddLine(A, B, C, D).Select '坐标(A=?,B=列高1 ,C=?,D=列高2),像数转高度公式:像数*0.75
Selection.ShapeRange.Line.Weight = 1.5 '粗细
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 '颜色
A = 0
B = 0
C = 0
D = 0
Cells(K, 39) = 1
End If
Next
Range("A1").Select
Sheet1.Protect Password:="123456"
End Sub
请问谁能给每个语句做上注释 |
|