Solved

Can I use VBA to apply corner radius on text box?

Posted on 2013-01-06
9
1,010 Views
Last Modified: 2013-01-17
Hi All

I have a textbox with a table in it (not sure if that it a terrible idea, but it seems to be working) and I would like to apply rounded corners to the text box such that a specific radius is maintained...

I tried to record a macro to see what happens... but this is all I got:

  ActiveDocument.Shapes.Range(Array("Rounded Rectangle 5")).Select

(changing the corner was not recorded, grr)

help on this much appreciated.

Oh BTW - if this is a terrible idea (I'm using cross references and headings in my table & textbox) please let me know...

Cheers, S
0
Comment
Question by:DrTribos
  • 3
  • 3
  • 3
9 Comments
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 38748227
Hi,

Please refer to http://excelusergroup.org/forums/t/2450.aspx

Public Sub AddRoundRect()
    Dim sht As Worksheet
    Dim rect As Shape
  
    Set sht = ActiveSheet
    Set rect = sht.Shapes.AddShape(msoShapeRoundedRectangle, 400, 110, 150, 75)
    With rect.TextFrame2
   
        .TextRange = "Some Text In Here"
        .VerticalAnchor = msoAnchorMiddle
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
    End With
End Sub

Open in new window

Regards
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 38748375
Hi Steve,
This seems to work for me:
    Dim tb As Shape
    
    Set tb = ActiveDocument.Shapes(1)
   tb.AutoShapeType = msoShapeRoundedRectangle

Open in new window

0
 
LVL 15

Author Comment

by:DrTribos
ID: 38748420
Hi Rgonzo1971 & Graham

Thanks for the code.  As far as I can tell the parameters that can be passed to msoShapeRoundedRectangle are to position the shape on the page and do not specify the radius...

The problem for me is that the text box resizes as text is entered / removed and the radii on the corners changes...  I'd rather my (my users) radii to remain constant... (I have a similar problem with callouts... the tail changes size with the textbox... most annoying).

I tested msoShapeRoundedRectangle after dragging the shape around a bit and it does indeed put the radii back to some default... but this depends on height & width :-(

Cheers, S
0
Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

 
LVL 76

Expert Comment

by:GrahamSkan
ID: 38748453
I don't think that there is any way to directly control the radii of the corners. They depend on the size of the shape, so that they stay in proportion.
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 38770028
0
 
LVL 15

Author Comment

by:DrTribos
ID: 38773322
Hi Rgonzo -  I get an EE Unauthorized Access Error when I try to follow your link.  It says the question has not yet been closed...  

Thanks, S
0
 
LVL 49

Accepted Solution

by:
Rgonzo1971 earned 400 total points
ID: 38773471
Sorry

Not yet reviewed

Sub GetRadius()

    Dim oSh As Shape
    Dim sngRadius As Single ' Radius size in points
    
    Set oSh = ActiveWindow.Selection.ShapeRange(1)

    With oSh
        If .Width < .Height Then
            sngRadius = .Width * .Adjustments(1)
        Else 'oSh.Width >= oSh.Height
            sngRadius = .Height * .Adjustments(1)
        End If
    End With
    
    MsgBox sngRadius

    Set oSh = Nothing

End Sub
 

 
Sub SetRadius()

    Dim oSh As Shape
    Dim sngRadius As Single ' Radius size in points

    sngRadius = 40

    Set oSh = ActiveWindow.Selection.ShapeRange(1)

    With oSh
        If .Width < .Height Then
            .Adjustments(1) = sngRadius / .Width
        Else 'oSh.Width >= oSh.Height
            .Adjustments(1) = sngRadius / .Height
        End If
    End With

    Set oSh = Nothing

End Sub 

Open in new window


Regards
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 38773681
Rgonzo1971,

I, for one, can thank you.

Previously, I couldn't find how to adjust the radius of the corners manually, so assumed that no such adjustment was possible. Your code prompted me to persevere.

The secret is to drag the yellow diamond shape near the top left of the selected shape. It is possible to do this while macro recording is on, so that the index in the Adjustments collection can be confirmed from the recorded code.

I hope that this information is in your article.
0
 
LVL 15

Author Closing Comment

by:DrTribos
ID: 38789478
Hi Rgonzo - thank you!
0

Featured Post

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Consumer laptop recommendation 6 71
Retrieve Windows Office Files from Parallels 12 VM 9 72
Excel 2016 - Black cell borders 11 34
how to re-acticvate Office 2010 6 41
Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
My experience with Windows 10 over a one year period and suggestions for smooth operation
This video walks the viewer through the process of creating Hyperlinks for the web and other documents. Select the "Insert" tab: Click "Hyperlink":  Type "http://" followed by a web address to reference a website or navigate to a document to ref…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question