didijaba
Well-known Member
- Joined
- Nov 26, 2006
- Messages
- 511
Hello,
I have shapes created but don't know how to set them to position. This is my code so far.
I have shapes created but don't know how to set them to position. This is my code so far.
Code:
':::::::::::::::::::::::::::::::::::::::::::::::::: RECTANGLE
Dim j As Long
Dim LastNumeric As Integer
Dim ws As Worksheet
Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double
Dim cl As Range
Dim x1, y1, x2, y2, x3, y3, x4, y4 As Variant
Set cl = Range("J11") '<-- Range("J11")
clLeft = cl.Left
clTop = cl.Top
clHeight = cl.Height
clWidth = cl.Width
LastNumeric = Range("S" & Rows.Count).End(xlUp).Row
For j = 38 To LastNumeric
x1 = Range("AF" & j) * 7
y1 = Range("AG" & j) * 7
x2 = Range("AH" & j) * 7
y2 = Range("AI" & j) * 7
x3 = Range("AP" & j) * 7
y3 = Range("AQ" & j) * 7
x4 = Range("AL" & j) * 7
y4 = Range("AM" & j) * 7
ActiveSheet.Shapes.AddLine(x1 + clLeft, y1 + clTop, x2 + clLeft, y2 + clTop).Select
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Visible = msoTrue
.Weight = 5
.Transparency = 0
.Visible = msoTrue
.DashStyle = msoLineDash
End With
With Selection.ShapeRange.Fill
.Visible = msoFalse
End With
ActiveSheet.Shapes.AddLine(x2 + clLeft, y2 + clTop, x3 + clLeft, y3 + clTop).Select
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Visible = msoTrue
.Weight = 5
.Transparency = 0
.Visible = msoTrue
.DashStyle = msoLineDash
End With
With Selection.ShapeRange.Fill
.Visible = msoFalse
End With
ActiveSheet.Shapes.AddLine(x3 + clLeft, y3 + clTop, x4 + clLeft, y4 + clTop).Select
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Visible = msoTrue
.Weight = 5
.Transparency = 0
.Visible = msoTrue
.DashStyle = msoLineDash
End With
With Selection.ShapeRange.Fill
.Visible = msoFalse
End With
ActiveSheet.Shapes.AddLine(x1 + clLeft, y1 + clTop, x4 + clLeft, y4 + clTop).Select
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Visible = msoTrue
.Weight = 5
.Transparency = 0
.Visible = msoTrue
.DashStyle = msoLineDash
End With
With Selection.ShapeRange.Fill
.Visible = msoFalse
End With
'???????????????????????????????????????????????????????????????
Dim triArray(1 To 5, 1 To 2) As Single
triArray(1, 1) = x1
triArray(1, 2) = y1
triArray(2, 1) = x2
triArray(2, 2) = y2
triArray(3, 1) = x3
triArray(3, 2) = y3
triArray(4, 1) = x4
triArray(4, 2) = y4
triArray(5, 1) = x1 ' Last point has same coordinates as first
triArray(5, 2) = y1
Set ws = ActiveSheet
ws.Shapes.AddPolyline triArray
With ActiveSheet.Shapes
.Left = x1 + clLeft
.Top = y1 + clTop
End With