View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
tony tony is offline
external usenet poster
 
Posts: 313
Default rotation of an arrow created by an drawing object

I used your sugestions with sucess. The lines of code work well. Basicly it
creates a guage. One of the last objects added is a circle with the following
line of code.

Set myCircle = ActiveSheet.Ovals.Add(OriginX - (cSize \ 2), OriginY - (cSize
\ 2), _
cSize, cSize)
this works fine, but I wantt the circle to be a bit bigger than the actual
tick marks on the guage so I modify this line of code by adding the varriable
"offset" to the last to parms.

Set myCircle = ActiveSheet.Ovals.Add(OriginX - (cSize \ 2), OriginY - (cSize
\ 2), _
cSize + offset, cSize+ offset)

when this line of code is executed then the circle is bigger, hoever it is
offset from the origin by a few points and I cant figure out why. Can you
help







Sub Tick()

'you can 't rotate a line like you would a shape. Setting your origins
'properly you can make the rotation much easier. See the code below. You may
'want to change the scale as needed.

'Direction is backwards on a spreadsheet. Positive Y is in the direction of
'increasing rows. To compensate, the plus and minus signs in the Start Y and
'End Y are opposite from the Start X and Start Y.

'
' Macro20 Macro
' Macro recorded 12/24/2007 by Anthony Keefe
'

Dim TickAray(360) As Object
Dim ThisHorizontalAxis As Variant
Dim ThisVerticalAxis As Variant
Pi = 3.14159265358979


ticks = 1
TickSize = 5
stepFreq = 5
MajorTickFrequency = 45
cSize = 200
InstrumentLable = "ProtoType"
Offset = 25

Call FindOrgin(OriginX, OriginY)
Call DrawAxes(OriginX, OriginY, oThisHorizontalAxis, oThisVerticalAxis)



For I = 360 To ticks Step -stepFreq
Call DevelopVectors(I, OriginX, OriginY, StartX, EndX, StartY, EndY, cSize)


If I Mod MajorTickFrequency = 0 Then
TickType = 2#
TickSize = 10
Else
TickType = 0.025
TickSize = 5
End If



radian = (I * Pi) / 180#
StartTickX = EndX
StartTickY = EndY
EndTickX = StartTickX + (TickSize * Cos(radian))
EndTickY = StartTickY - (TickSize * Sin(radian))

Set oTick = ActiveSheet.Shapes. _
AddLine(StartTickX, StartTickY, EndTickX, EndTickY)





With oTick
.Rotation = 180
'.Name = "G_" & InstrumentLable & "Tick" & i
.Line.Weight = TickType
.Visible = msoTrue
.Line.BackColor.RGB = RGB(255, 255, 255)
.Line.BeginArrowheadStyle = msoArrowheadNone
.Line.EndArrowheadLength = msoArrowheadLengthMedium
.Line.EndArrowheadWidth = msoArrowheadWidthMedium
.Line.EndArrowheadStyle = msoArrowheadNone
End With


Set TickAray(I) = oTick

'dial.delete
Next
Set dial = ActiveSheet.Shapes. _
AddLine(StartX + 4, StartY + 4, EndX - 4, EndY - 4)
With dial
.Line.Weight = 4
.Line.EndArrowheadStyle = msoArrowheadTriangle
.Line.EndArrowheadLength = msoArrowheadLengthMedium
.Line.EndArrowheadWidth = msoArrowheadWidthMedium
End With


Set myCircle = ActiveSheet.Ovals.Add(OriginX - (cSize \ 2), OriginY - (cSize
\ 2), _
cSize, cSize)


With myCircle
..ShapeRange.ZOrder msoSendToBack
End With

'oThisHorizontalAxis.delete
'oThisVerticalAxis.delete
'ActiveSheet.Lines.Group




z = z

End Sub


Sub DevelopVectors(Angle, OriginX, OriginY, StartX, EndX, StartY, EndY, cSize)
Pi = 3.14159265358979

radian = (Angle * Pi) / 180#
StartX = OriginX - ((cSize / 2) * Cos(radian))
EndX = OriginX + (cSize / 2 * Cos(radian))
'plus and minus opposite from x because positive
'y direction is backwards on spreadsheet.
StartY = OriginY + (cSize / 2 * Sin(radian))
EndY = OriginY - (cSize / 2 * Sin(radian))


End Sub

Sub DrawAxes(OriginX As Variant, OriginY As Variant, ByRef
oThisHorizontalAxis As Variant, ByRef oThisVerticalAxis As Variant)



Set oThisHorizontalAxis = ActiveSheet.Shapes.AddLine(MarginLeft, OriginY, 2
* OriginX, OriginY) 'Draw X Axis
Set oThisVerticalAxis = ActiveSheet.Shapes.AddLine(OriginX, MarginBottom,
OriginX, 2 * OriginY) ' Draw Y Axis

End Sub

Sub FindOrgin(OriginX As Variant, OriginY As Variant)
Range("a1").Select

MarginLeft = 0.075
OriginX = (Application.UsableWidth + MarginLeft) / 2
MarginTop = 0.075
OriginY = (Application.UsableHeight + MarginTop) / 2
End Sub

Sub ObjectHitMan()


For Each ContractObject In ActiveSheet.Shapes
ContractObject.delete
Next
End Sub



"Joel" wrote:

Take out any ON ERROR statement yhou may have in your code while debugging.
The ON ERROR statements tend to skip around where the real problem lies. I
don't have all your code and don't think what you are doing will work

I don't know what dial or tickmark are equal to, but if dial is the same
code as before I do't think this will work

Set currentGroup = ActiveSheet.Shapes.Range(Array(Dial, tickmark)) 'no problem

You only added one Dial shape to the worksheet and it is not an array.


I found the code belowin the VBA help. I doesn't show everything
-----------------------------------------------------------------------------------------------
Use Shapes.Range(index), where index is the shapes name or index number or
an array of shape names or index numbers, to return a ShapeRange collection
that represents a subset of the Shapes collection. The following example sets
the fill pattern for shapes one and three on myDocument.

Set myDocument = Worksheets(1)
myDocument.Shapes.Range(Array(1, 3)).Fill.Patterned _
msoPatternHorizontalBrick
------------------------------------------------------------------------------------------
Note in the expalination it says "shapes one and three". You need to have
an array of lines called "Dial" (more than one).

Also shapes have a visable property. You may want to have many dial shapes
on your worksheet and only make one of them visible at a time.

"TONY" wrote:

Thanks Jole that helped.

I have come across another problem with the basicly the same code.

you see how "dial" and "tickmark" varriables are set to line objects. Below
is a snipet of code that causes the problem.

Set currentGroup = ActiveSheet.Shapes.Range(Array(Dial, tickmark)) 'no problem


With currentGroup' no problem here
.Group.Select ' no problem here
.Rotation = I 'no problem here
.Ungroup.Select BIG PROBLEM HERE
End With

The Ungroup.select executes with no problem itself, but the object
varriables "Dial", "TickMark" and "currentGroup" are set to nothing they no
longer point to the line objects created. Can you help?

One other thing. Is there a all comprehensive book that covers VBA. I have 5
books all claiming to be the "definitive" guid, they only skim the various
subjects.


Thanks Tony

"TONY" wrote:

Below is a macro that first creates "cross hairs" on the spread sheet No
problem her. In addition a 3rd line is created with an arrow head no problem
here either.

I can select the arrow open the format boxx and change it's rotation with no
problem, however I can not from within the program itself. The arrow moves
to aprox 45 degrees and does not at all.

Sub Macro20()
'
' Macro20 Macro
' Macro recorded 12/24/2007 by Anthony Keefe
'
cSize = 50
Range("a1").Select

Set myHz = ActiveSheet.Shapes.AddLine(0.075, Application.UsableHeight * 0.5,
Application.UsableWidth, Application.UsableHeight * 0.5)
Set myv = ActiveSheet.Shapes.AddLine(Application.UsableWidth * 0.5, 0.075,
Application.UsableWidth * 0.5, Application.UsableHeight)


Set dial = ActiveSheet.Shapes.AddLine(Application.UsableWidth * 0.5 -
cSize, Application.UsableHeight * 0.5 + cSize, _
(Application.UsableWidth * 0.5 +
cSize), (Application.UsableHeight * 0.5) - cSize)

With dial.Line
.EndArrowheadStyle = msoArrowheadTriangle
.EndArrowheadLength = msoArrowheadLengthMedium
.EndArrowheadWidth = msoArrowheadWidthMedium

End With
With dial

.Rotation = 0# ' Reset arrow to 0
.Rotation = 1#
.Rotation = 2#
End With




myHz.delete
myv.delete
dial.delete


End Sub