Sub DrawCorgi()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
' Draw body
Dim body As Shape
Set body = ws.Shapes.AddShape(msoShapeOval, 50, 50, 200, 100)
body.Fill.ForeColor.RGB = RGB(255, 204, 102)
' Draw head
Dim head As Shape
Set head = ws.Shapes.AddShape(msoShapeOval, 220, 20, 100, 100)
head.Fill.ForeColor.RGB = RGB(255, 204, 102)
' Draw left ear
Dim leftEar As Shape
Set leftEar = ws.Shapes.AddShape(msoShapeIsoscelesTriangle, 230, 10, 20, 40)
leftEar.Fill.ForeColor.RGB = RGB(255, 204, 102)
leftEar.Rotation = 40
' Draw right ear
Dim rightEar As Shape
Set rightEar = ws.Shapes.AddShape(msoShapeIsoscelesTriangle, 290, 10, 20, 40)
rightEar.Fill.ForeColor.RGB = RGB(255, 204, 102)
rightEar.Rotation = -40
' Draw left leg
Dim leftLeg As Shape
Set leftLeg = ws.Shapes.AddShape(msoShapeRectangle, 90, 130, 20, 60)
leftLeg.Fill.ForeColor.RGB = RGB(255, 204, 102)
' Draw right leg
Dim rightLeg As Shape
Set rightLeg = ws.Shapes.AddShape(msoShapeRectangle, 190, 130, 20, 60)
rightLeg.Fill.ForeColor.RGB = RGB(255, 204, 102)
' Draw left eye
Dim leftEye As Shape
Set leftEye = ws.Shapes.AddShape(msoShapeOval, 250, 40, 20, 20)
leftEye.Fill.ForeColor.RGB = RGB(0, 0, 0)
' Draw right eye
Dim rightEye As Shape
Set rightEye = ws.Shapes.AddShape(msoShapeOval, 270, 40, 20, 20)
rightEye.Fill.ForeColor.RGB = RGB(0, 0, 0)
' Draw mouth
Dim mouth As Shape
Set mouth = ws.Shapes.AddShape(msoShapeArc, 250, 65, 40, 30)
mouth.Fill.Visible = msoFalse
mouth.Line.Weight = 2
mouth.Line.ForeColor.RGB = RGB(0, 0, 0)
' Draw nose
Dim nose As Shape
Set nose = ws.Shapes.AddShape(msoShapeOval, 260, 60, 20, 10)
nose.Fill.ForeColor.RGB = RGB(0, 0, 0)
' Draw tail
Dim tail As Shape
Set tail = ws.Shapes.AddShape(msoShapeIsoscelesTriangle, 50, 80, 20, 40)
tail.Fill.ForeColor.RGB = RGB(255, 204, 102)
tail.Rotation = 180
' Group all shapes
Dim allShapes() As Variant
allShapes = Array(body.Name, head.Name, leftEar.Name, rightEar.Name, leftLeg.Name, rightLeg.Name, leftEye.Name, rightEye.Name, mouth.Name, nose.Name, tail.Name)
ws.Shapes.Range(allShapes).Select
ws.Shapes.Range(allShapes).Group
' Add some decoration on ears
Dim leftEarDeco As Shape
Set leftEarDeco = ws.Shapes.AddShape(msoShapeOval, 235, 15, 10, 20)
leftEarDeco.Fill.ForeColor.RGB = RGB(192, 0, 0)
leftEarDeco.Rotation = 40
Dim rightEarDeco As Shape
Set rightEarDeco = ws.Shapes.AddShape(msoShapeOval, 295, 15, 10, 20)
rightEarDeco.Fill.ForeColor.RGB = RGB(192, 0, 0)
rightEarDeco.Rotation = -40
' Add collar
Dim collar As Shape
Set collar = ws.Shapes.AddShape(msoShapeOval, 225, 95, 90, 10)
collar.Fill.ForeColor.RGB = RGB(0, 0, 255)
collar.Line.Visible = msoFalse
' Add name tag
Dim nameTag As Shape
Set nameTag = ws.Shapes.AddShape(msoShapeOval, 320, 100, 20, 20)
nameTag.Fill.ForeColor.RGB = RGB(255, 255, 0)
nameTag.Line.Visible = msoFalse
' Group all shapes again
Dim allShapesWithDeco() As Variant
allShapesWithDeco = Array(body.Name, head.Name, leftEar.Name, rightEar.Name, leftLeg.Name, rightLeg.Name, leftEye.Name, rightEye.Name, mouth.Name, nose.Name, tail.Name, leftEarDeco.Name, rightEarDeco.Name, collar.Name, nameTag.Name)
ws.Shapes.Range(allShapesWithDeco).Select
ws.Shapes.Range(allShapesWithDeco).Group
End Sub
利用Excel,VBA代码在工作表中画一张柯基狗的图片
猜你喜欢
转载自blog.csdn.net/tuzajun/article/details/130417899
今日推荐
周排行