У меня есть макрос, расставляющий кружки по направлению ломаной линии. Однако этот макрос расставляет не точные копии фигуры, указанной в макросе (Овал 16), а просто расставляет обычные круги.
Как поменять макрос, чтобы он расставлял именно полностью точные копии указанной в макросе фигуры ?
Доброго дня, уважаемые специалисты по экселю.
У меня есть макрос, расставляющий кружки по направлению ломаной линии. Однако этот макрос расставляет не точные копии фигуры, указанной в макросе (Овал 16), а просто расставляет обычные круги.
Как поменять макрос, чтобы он расставлял именно полностью точные копии указанной в макросе фигуры ?Snegovik
Sub drawCircles() Dim pCircle As Shape Dim pPoly As Shape Dim pNodes As ShapeNodes Dim pSheet As Worksheet Dim kNode As Long, xOff As Double, yOff As Double Dim dX As Double, dY As Double, pointDist As Double Dim Xc As Double, Yc As Double, curDist As Double Set pSheet = ActiveSheet Set pPoly = pSheet.Shapes("Полилиния 2") Set pCircle = pSheet.Shapes("Овал 16") xOff = -0.5 * pCircle.Width yOff = -0.5 * pCircle.Height curDist = 0# Set pNodes = pPoly.Nodes For kNode = 1 To pNodes.Count - 1 dX = pNodes(kNode + 1).Points(1, 1) - pNodes(kNode).Points(1, 1) dY = pNodes(kNode + 1).Points(1, 2) - pNodes(kNode).Points(1, 2) pointDist = Math.Sqr(dX ^ 2 + dY ^ 2) dX = dX / pointDist dY = dY / pointDist Do Until curDist > pointDist Xc = pNodes(kNode).Points(1, 1) + curDist * dX + xOff Yc = pNodes(kNode).Points(1, 2) + curDist * dY + yOff 'pSheet.Shapes.AddShape msoShapeOval, Xc, Yc, pCircle.Width, pCircle.Height With [Овал 16].Duplicate .Top = Yc .Left = Xc End With curDist = curDist + 50 Loop curDist = curDist - pointDist Next End Sub
[/vba]
Доброго. Какой-то у вас овал квадратный [vba]
Код
Sub drawCircles() Dim pCircle As Shape Dim pPoly As Shape Dim pNodes As ShapeNodes Dim pSheet As Worksheet Dim kNode As Long, xOff As Double, yOff As Double Dim dX As Double, dY As Double, pointDist As Double Dim Xc As Double, Yc As Double, curDist As Double Set pSheet = ActiveSheet Set pPoly = pSheet.Shapes("Полилиния 2") Set pCircle = pSheet.Shapes("Овал 16") xOff = -0.5 * pCircle.Width yOff = -0.5 * pCircle.Height curDist = 0# Set pNodes = pPoly.Nodes For kNode = 1 To pNodes.Count - 1 dX = pNodes(kNode + 1).Points(1, 1) - pNodes(kNode).Points(1, 1) dY = pNodes(kNode + 1).Points(1, 2) - pNodes(kNode).Points(1, 2) pointDist = Math.Sqr(dX ^ 2 + dY ^ 2) dX = dX / pointDist dY = dY / pointDist Do Until curDist > pointDist Xc = pNodes(kNode).Points(1, 1) + curDist * dX + xOff Yc = pNodes(kNode).Points(1, 2) + curDist * dY + yOff 'pSheet.Shapes.AddShape msoShapeOval, Xc, Yc, pCircle.Width, pCircle.Height With [Овал 16].Duplicate .Top = Yc .Left = Xc End With curDist = curDist + 50 Loop curDist = curDist - pointDist Next End Sub