INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Show Area of Shape insert

Show Area of Shape insert

(OP)
Dear all,
I wish to get the area of shapes to be shown whenever I insert new shape to excel.
Here is my coding.
currently I'm using divide to convert the point to inches, is there code to convert from point to inch?

Sub ShowArea()

For x = 1 To 50
Sheet1.Shapes(x).TextFrame.Characters.Text = Round(((Sheet1.Shapes(x).Width / 72) * (Sheet1.Shapes(x).Height / 72)), 2)
Next x

End Sub

Thank you.

RE: Show Area of Shape insert

Although Word has builtin functions for CentimetersToPoints, InchesToPoints, PointsToCentimeters, PointsToInches, Excel lacks them. You could, of course, create them. For example:

CODE

Function PointsToCentimeters(sngSize As Single)
PointsToCentimeters = sngSize * 2.54 / 72
End Function

Function PointsToInches(sngSize As Single)
PointsToInches = sngSize / 72
End Function

Function CentimetersToPoints(sngSize As Single)
CentimetersToPoints = sngSize * 72 / 2.54
End Function

Function InchesToPoints(sngSize As Single)
InchesToPoints = sngSize * 72
End Function 

Cheers
Paul Edstein
[MS MVP - Word]

RE: Show Area of Shape insert

(OP)
Hi macropod,
Thanks.

Perhaps you could help me further in below problem.
The code I have is to show the area of the shape I insert.
Now, all the shapes in the Excel Sheet will be shown the area once I hit the macro.
How if I only wan the shape which is active?
I tried with below code but it seems to be error.

ActiveSheet1.ActiveShapes.Select

Thanks.

RE: Show Area of Shape insert

If you want to get the selected shape, use something along the lines of:
MsgBox Selection.ShapeRange(1).Name
Thus:

CODE

With Selection.ShapeRange(1)
  MsgBox Round((.Width * .Height / 72 ^ 2), 2)
End With 

Cheers
Paul Edstein
[MS MVP - Word]

RE: Show Area of Shape insert

(OP)
Hi macropod,
Thank you very much~~~

RE: Show Area of Shape insert

>Excel lacks them

Er ... Excel does have them, at least the first 2 (and consequently we can simply derive the remaining 2), it is just that they are slightly borked, in the sense that they need to be qualified as Application, i.e.

Application.CentimetersToPoints
Application.InchesToPoints

RE: Show Area of Shape insert

Thanks strongm. That would explain why I got errors trying to use any of them...

Cheers
Paul Edstein
[MS MVP - Word]

RE: Show Area of Shape insert

(OP)
Hi Strongm,
Thanks.
1). If I wish to have more than one data (width, height, area) show in the shape insert, how could I make it?
I tried with "+" but error prompted.
If separated to different coding, only one data will be shown.

2). What if I need the data to be shown automatically when I change the original shape? I tried with Change function but it doesn't work.
Private Sub ActiveShapes_Change(ByVal Target As String)
If Selection.ShapeRange(1).Change Then
Call ShowArea
End If
End Sub

RE: Show Area of Shape insert

>If I wish to have more than one data (width, height, area) show in the shape insert
Have you tried something like this:

CODE

Sub ShowArea()

For x = 1 To 50
  Sheet1.Shapes(x).TextFrame.Characters.Text = "Width = " & 125 & _
    ", Height = " & 250 & ", Area = " & 125 * 250
Next x

End Sub 

Just replace the BLUE hard-coded numbers with your calculated values.

Have fun.

---- Andy

There is a great need for a sarcasm font.

RE: Show Area of Shape insert

I would not hard code the number of shapes in your sheet, WHATEVER SHEET your changing...

CODE

Sub ShowArea()
    Dim shp As Shape
    
    For Each shp In ActiveSheet.Shapes
      shp.TextFrame.Characters.Text = "Width = " & shp.Width & _
        ", Height = " & shp.Height & ", Area = " & shp.Width * shp.Height
    Next
End Sub 

Of course, substitute your conversions.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Show Area of Shape insert

(OP)
Hi Andrzejek, SkipVought,
Thanks for the suggestion.
How bout the Auto Change of data if I change the shape?

Besides,
I'm using Round function for the area calculation but the decimal point seems to be having bugs.
If I had my coding for >0 of decimal point, the data shows will be 13 decimal points.
Sub ShowArea()
Dim Width As Single
Dim Height As Single

Width = Selection.ShapeRange(1).Width / 72
Height = Selection.ShapeRange(1).Height / 72

With Selection.ShapeRange(1)

Selection.ShapeRange(1).TextFrame.Characters.Text = Round(Width * Height, 1)

End With

End Sub

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close