AutoShapes VBA Macro

Jdax57 · Apr 12, 2010

I'm trying to find a way to create a Macro in Excel 2007 that creates/formats an existin AutoShape Arrow (msoShapeUpArrow) With the following properties (H: 0.13" W:0.49") With the rotation being flexible dependent on a cardinal direction (meaning If the spreadsheet shows South it would equate the arrow pointing to 180 Degrees).

Example:

Day 1 Winds from NW (ARROW 1 pointing to 125 in Cell E23)
Day 2 Winds from W (ARROW 2 pointing to 090 in cell M23)
Day 3 Winds from SW (ARROW 3 pointing to 045 in cell U23)
Day 4 Winds from N (ARROW 4 pointing to 180 in Cell AC23)
Day 5 Winds from NW (ARROW 5 pointing to 125 in Cell AK23)

And if wind direction is VRB the ARROW would be hidden or deleted.

I can reference the wind direction conversion to another block and pull the converted heading to be used in the macro to determind the direction of the arrow. Can anyone help me with this?

Thanks!

Alex

Jdax57 · Apr 14, 2010

****** http-equiv="Content-Type" content="text/html; charset=utf-8">****** name="ProgId" content="Word.Document">****** name="Generator" content="Microsoft Word 12">****** name="Originator" content="Microsoft Word 12"><link rel="File-List" href="file:///C:%5CUsers%5CDeimos%5CAppData%5CLocal%5CTemp%5Cmsohtmlclip1%5C01%5Cclip_filelist.xml"><link rel="themeData" href="file:///C:%5CUsers%5CDeimos%5CAppData%5CLocal%5CTemp%5Cmsohtmlclip1%5C01%5Cclip_themedata.thmx"><link rel="colorSchemeMapping" href="file:///C:%5CUsers%5CDeimos%5CAppData%5CLocal%5CTemp%5Cmsohtmlclip1%5C01%5Cclip_colorschememapping.xml"><style> <!-- /* Font Definitions */ @font-face {font-family:"ＭＳ明朝"; panose-1:2 2 6 9 4 2 5 8 3 4; mso-font-alt:"MS Mincho"; mso-font-charset:128; mso-generic-font-family:roman; mso-font-pitch:fixed; mso-font-signature:-536870145 1791491579 18 0 131231 0;} @font-face {font-family:"Cambria Math"; panose-1:2 4 5 3 5 4 6 3 2 4; mso-font-charset:1; mso-generic-font-family:roman; mso-font-format

ther; mso-font-pitch:variable; mso-font-signature:0 0 0 0 0 0;} @font-face {font-family:Calibri; panose-1:2 15 5 2 2 2 4 3 2 4; mso-font-charset:0; mso-generic-font-family:swiss; mso-font-pitch:variable; mso-font-signature:-520092929 1073786111 9 0 415 0;} @font-face {font-family:"\@ＭＳ明朝"; panose-1:2 2 6 9 4 2 5 8 3 4; mso-font-charset:128; mso-generic-font-family:roman; mso-font-pitch:fixed; mso-font-signature:-536870145 1791491579 18 0 131231 0;} /* Style Definitions */ p.MsoNormal, li.MsoNormal, div.MsoNormal {mso-style-unhide:no; mso-style-qformat:yes; mso-style-parent:""; margin-top:0in; margin-right:0in; margin-bottom:10.0pt; margin-left:0in; line-height:115%; mso-pagination:widow-orphan; font-size:11.0pt; font-family:"Calibri","sans-serif"; mso-ascii-font-family:Calibri; mso-ascii-theme-font:minor-latin; mso-fareast-font-family:"ＭＳ明朝"; mso-fareast-theme-font:minor-fareast; mso-hansi-font-family:Calibri; mso-hansi-theme-font:minor-latin; mso-bidi-font-family:"Times New Roman"; mso-bidi-theme-font:minor-bidi;} .MsoChpDefault {mso-style-type:export-only; mso-default-props:yes; mso-ascii-font-family:Calibri; mso-ascii-theme-font:minor-latin; mso-fareast-font-family:"ＭＳ明朝"; mso-fareast-theme-font:minor-fareast; mso-hansi-font-family:Calibri; mso-hansi-theme-font:minor-latin; mso-bidi-font-family:"Times New Roman"; mso-bidi-theme-font:minor-bidi;} .MsoPapDefault {mso-style-type:export-only; margin-bottom:10.0pt; line-height:115%;} @page Section1 {size:8.5in 11.0in; margin:1.0in 1.0in 1.0in 1.0in; mso-header-margin:.5in; mso-footer-margin:.5in; mso-paper-source:0;} div.Section1 {page:Section1;} --> </style> Oh yea about that I added the "1" to the code. What I'm working on is a 5 day Weather forecast. We have wind directions that get added. Right now I have 5 arrows being created/deleted using the code you gave me. And it works great, no issues thus far. The problem I ran into is when the winds are "variable or VRB" we don't put an arrow on the 5 day forecast. I'll be honest i'm not the best at VBA...I can manage to stumble upon some codes here and there and Forums that I ask help in. And then I adjust the code to fit my needs. Regardless this is what I got so far:

Public Sub CreateArrow1()

'Run this procedure once to create & name the arrow

Dim oShape As Shape
Dim oActive As Worksheet
Dim oArrowCell As Range
Dim oRot As Variant

Set oActive = ActiveSheet 'Enable intellisense

oRot = Range("B1").Value

If oRot = "NONE" Then

'Delete the arrow if wind direction is NONE
For Each oShape In oActive.Shapes
If oShape.Name = "WindDirArrow1" Then oShape.Delete
Next
Else

'Delete the arrow if it already exists
For Each oShape In oActive.Shapes
If oShape.Name = "WindDirArrow1" Then oShape.Delete
Next
'Set desired origin cell
Set oArrowCell = oActive.Range("D12")

'Create a new arrow
Set oShape = oActive.Shapes.AddShape(msoShapeUpArrow, oArrowCell.Left, oArrowCell.Top, 15, 50)

'Name the arrow for easy ID
oShape.Name = "WindDirArrow1"

With oShape
'Left, Top, Width, Height & Rotation, unnecessary, same as insertion size above
.Left = oArrowCell.Left
.Top = oArrowCell.Top
.Width = 10
.Height = 32
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Rotation = oRot

'.Whatever else
End With
End If

End Sub

I Figured that IF oRot = "None" (what I can convert VRB to) Then it should either hide or delete the arrow. Like so?
<o

> </o

>
oRot = Range("B1").Value

If oRot = "NONE" Then
ActiveSheet.Shapes("WindDirArrow1").Visible = msoFalse
Else ActiveSheet.Shapes("WindDirArrow1").Visible = msoTrue


Alex

Gary McMaster · Apr 14, 2010

If your "oRot" variable is going to contain a mixture of text and numbers you'll need more code to handle conversions. Maybe it would be better to use either 0 or 360 for the "hide flag" since they are actually the same direction. A negative number would also be an option. Either way the value would always be numeric and easier to deal with than a mixture.

Gary

Jdax57 · Apr 14, 2010

THought crossed my mind....So I went back to a oRot as Long

with VRB = 0

If oRot = "0" Then
ActiveSheet.oShapes("WindDirArrow1").Visible = msoFalse

End If

But it seems to crud out for some reason. If I make oRot = 0 then I get an object error..

and if I don't use the quotes I also get an error...Maybe I'm missing something...?

Gary McMaster · Apr 14, 2010

In your last post you have "oRot" declared as a Variant. Basically it can become almost any type of variable you tell it to. If you put a number in quotes the variant type will convert it to a string. If it doesn't have quotes it will convert it to a numeric type (not sure which one).

I would declare that variable as whatever type the shape wants for a rotation argument. I believe its "long" but you should check help to make sure.

Gary

Jdax57 · Apr 14, 2010

Gary this is what I got now...Crashes on me at the after the if/then statement.

Public Sub CreateArrow()

'Run this procedure once to create & name the arrow

Dim oShape As Shape
Dim oActive As Worksheet
Dim oArrowCell As Range
Dim oRot As Long

Set oActive = ActiveSheet 'Enable intellisense

oRot = Range("B1").Value

If oRot = "0" Then
ActiveSheet.oShapes("WindDirArrow1").Visible = msoFalse

End If

'Delete the arrow if it already exists
For Each oShape In oActive.Shapes
If oShape.Name = "WindDirArrow1" Then oShape.Delete
Next
'Set desired origin cell
Set oArrowCell = oActive.Range("D12")

'Create a new arrow
Set oShape = oActive.Shapes.AddShape(msoShapeUpArrow, oArrowCell.Left, oArrowCell.Top, 15, 50)

'Name the arrow for easy ID
oShape.Name = "WindDirArrow1"

With oShape
'Left, Top, Width, Height & Rotation, unnecessary, same as insertion size above
.Left = oArrowCell.Left
.Top = oArrowCell.Top
.Width = 10
.Height = 32
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Rotation = oRot

'.Whatever else
End With

End Sub

Gary McMaster · Apr 14, 2010

The following line is wrong:

ActiveSheet.oShapes("WindDirArrow1").Visible = msoFalse

It should be: (minus the "o" in front of shapes)

ActiveSheet.Shapes("WindDirArrow1").Visible = msoFalse

The location is also potentially wrong. The shape may not even exist yet. It is created or deleted/recreated in the block of code immediately below that.

One place to put it would be after the "End With"

Gary

Jdax57 · Apr 15, 2010

Gary....It worked perfect. Moving the code to end fixed the issue...I completely appreciate all the help you've provided!

Alex

AutoShapes VBA Macro

Jdax57

New Member

Jdax57

New Member

Gary McMaster

Well-known Member

Jdax57

New Member

Gary McMaster

Well-known Member

Jdax57

New Member

Gary McMaster

Well-known Member

Jdax57

New Member

Similar threads

Share this page

AutoShapes VBA Macro

New Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock