excel自定义画直线函数和画直线代码

excel定义画直线函数

Function DrawLine(xRan As Range, yRan As Range)

On Error Resume Next '调用自定义函数时，不需要用application.WorksheetFunction.这句！！ Dim xSh As Worksheet

If xRan.Column = yRan.Column Then

With Application.Caller.Parent.Shapes.AddLine _

(IIf(xRan.Top>= yRan.Top, xRan.Offset(1, 0).Left + xRan.Width / 2, yRan.Offset(1, 0).Left + yRan.Width / 2), _

WorksheetFunction.Min(xRan.Offset(1, 0).Top, yRan.Offset(1, 0).Top), _

IIf(xRan.Top<yRan.Top, xRan.Offset(1, 0).Left + xRan.Width / 2, yRan.Offset(1, 0).Left + yRan.Width / 2), _

WorksheetFunction.Max(xRan.Top, yRan.Top))

.Name = LineName

.Line.ForeColor.SchemeColor = 10

End With

Else

With Application.Caller.Parent.Shapes.AddLine _

(WorksheetFunction.Min(xRan.Offset(0, 1).Left, yRan.Offset(0, 1).Left), _ IIf(xRan.Left<yRan.Left, xRan.Top + xRan.Height / 2, yRan.Top + yRan.Height / 2), _ WorksheetFunction.Max(xRan.Left, yRan.Left), _

IIf(xRan.Left>yRan.Left, xRan.Top + xRan.Height / 2, yRan.Top + yRan.Height / 2)) .Name = LineName

.Line.ForeColor.SchemeColor = 10

End With

End If

End Function

excel画直线VBA代码

Sub DD()

i = 5

j = 1

k = 3

l = 3

Dim xRan As Range

Dim yRan As Range

Set xRan = Cells(i, j)

Set yRan = Cells(k, l)

On Error Resume Next

If xRan.Column = yRan.Column Then

With ActiveSheet.Shapes.AddLine _

(IIf(xRan.Top>= yRan.Top, xRan.Offset(1, 0).Left + xRan.Width / 2, yRan.Offset(1,

0).Left + yRan.Width / 2), _

WorksheetFunction.Min(xRan.Offset(1, 0).Top, yRan.Offset(1, 0).Top), _

IIf(xRan.Top<yRan.Top, xRan.Offset(1, 0).Left + xRan.Width / 2, yRan.Offset(1, 0).Left + yRan.Width / 2), _

WorksheetFunction.Max(xRan.Top, yRan.Top))

.Name = LineName

.Line.ForeColor.SchemeColor = 10

End With

Else

With ActiveSheet.Shapes.AddLine _

(WorksheetFunction.Min(xRan.Offset(0, 1).Left, yRan.Offset(0, 1).Left), _ IIf(xRan.Left<yRan.Left, xRan.Top + xRan.Height / 2, yRan.Top + yRan.Height / 2), _ WorksheetFunction.Max(xRan.Left, yRan.Left), _

IIf(xRan.Left>yRan.Left, xRan.Top + xRan.Height / 2, yRan.Top + yRan.Height / 2))

.Name = LineName

.Line.ForeColor.SchemeColor = 10

End With

End If

End Sub