Rotate Autoshape Line

**StephenR** · Aug 23rd 2007

Hello All.

I'm trying to write some code to rotate a line by an amount specified in a cell. Each time this amount changes I want the bottom of the line to remain fixed so the line acts rather like that on a speedometer etc. However, the line moves each time and I can't work out the logic or how the AddLine parameters work and am stumped as to how to achieve this.

Please could anyone help?

My code so far is below:

Code

Private Sub Worksheet_Change(ByVal Target As Range)


Dim sshape As Shape


If Target.Address = "$J$18" Then


    For Each sshape In Sheet1.Shapes
        sshape.Delete
    Next


End If


    Set sshape = Sheet1.Shapes.AddLine(220, 270, 220, 170) 'XYXY


With sshape
    .Name = "Line 1"
    .Line.EndArrowheadStyle = msoArrowheadTriangle
    .Line.EndArrowheadLength = msoArrowheadLengthMedium
    .Line.EndArrowheadWidth = msoArrowheadWidthMedium
    '.Top = 1
    '.Left = -148.5
    .Height = 90
    .Width = 1
    .Rotation = Target
End With


End Sub

Display More

Sicarii · Aug 23rd 2007

Re: Rotating Autoshape Line

Just merged some code form here: http://www.ozgrid.com/forum/showthread.php?t=30075

Code

Private Sub blah()
     
    Dim sshape As Shape
    Dim lngAngle As Long
    Dim intIndex As Integer
     
    If Target.Address = "$J$18" Then
         
        For Each sshape In Sheet1.Shapes
            sshape.Delete
        Next
         
    End If
     
    Set sshape = Sheet1.Shapes.AddLine(220, 270, 220, 170) 'XYXY
     
    With sshape
      lngAngle = .Rotation + 1
      .Line.EndArrowheadStyle = msoArrowheadTriangle
      .Line.EndArrowheadLength = msoArrowheadLengthMedium
      .Line.EndArrowheadWidth = msoArrowheadWidthMedium
      .Height = 90
      .Width = 1
      For intIndex = 1 To 360
        If lngAngle > 360 Then lngAngle = 0
        .Rotation = lngAngle
        DoEvents
        For lngLoop = 1 To 10000
        Next
        lngAngle = lngAngle + 1
      Next
    End With
     
End Sub

Display More

**StephenR** · Aug 23rd 2007

Re: Rotating Autoshape Line

Sicarii,

Thanks for the suggestion. It looks very jolly but just spins the line round in a complete circle. If I limit the For..Next loop I just get the same problem in that the line won't stay fixed at any point.

Sicarii · Aug 23rd 2007

Re: Rotating Autoshape Line

I just figured it might get you on the right path. I'm leaving work in about 2 minutes, but if you haven't gotten by tomorrow I'll play around with it too.

I can see some nice uses with this. I've never used the autoshapes, but this could be modified to generate a "simpler" version of an Xcelsius report maybe. I don't know, good luck.

**StephenR** · Aug 23rd 2007

Re: Rotating Autoshape Line

Yes, I appreciate that. I'll keep experimenting. I have at least figured out that the line is rotated about its midpoint so the question is: can that be changed...

**Andy Pope** · Aug 24th 2007

Re: Rotate Autoshape Line

The quick and dirty way is to simply mask the bottom of the arrow/line.

You will probably find the complicated answer in Aaron's vector class code.
http://www.ozgrid.com/forum/showthread.php?t=54517

**StephenR** · Aug 24th 2007

Re: Rotate Autoshape Line

Andy Pope: quick and dirty it may be but that is very clever and will do for my purposes.

The vector class links don't appear to be working so I might contact Aaron about that.

Thanks again.

**Andy Pope** · Aug 24th 2007

Re: Rotate Autoshape Line

Aaron's site. You need to register to get at the downloads. Although I'm not sure if Vectors in in there.
http://xl-logic.com/index.php

**StephenR** · Aug 24th 2007

Re: Rotate Autoshape Line

Thanks Andy. I registered and the Vector stuff is there. Impressive what can be done with Excel - animated trains and all.

Rotate Autoshape Line

Participate now!

Share