Allow text to spill outside shape with Userform .TextFrame

G

GeeWhiz7

Board Regular
Joined
Nov 22, 2021
Messages
214
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
I can't quite figure out how to fix the following issue.

Background:
I made a userform to assist me in making timelines of various workstreams. Essentially it uses adds a shape of a certain length (duration) and some text to fill it in. Code snip that does that...

VBA Code: 
   If TaskCheck = True Then
        
        Set s = ws.Shapes.AddShape(Type:=msoShapeRectangle, _
        Left:=c.Left, _
        Top:=c.Top, _
        Width:=c.Width + Dur, _
        Height:=c.Height)
    
        s.Fill.ForeColor.RGB = RGB(R, G, B)
    
        With s.TextFrame
            .Characters.Text = tLabel
            .Characters.Font.ColorIndex = 3
            .Characters.Font.Color = RGB(0, 0, 0)
            .Characters.Font.Name = "Century Gothic"
            '    .Characters.Font.FontStyle = "Bold"
            .Characters.Font.Size = 12
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
        End With
    
    s.Select

My issue is that if the duration entered in the form (length of the shape) is not long enough, the text that would go inside gets only partially shown.
  • For example, a duration of 10 only shows the L for the text "Long Words Here"
  • Longer durations show a little more until the duration is long enough to hold all the text.
What I would like to do is shown as the last little gray box in the image below.
If the duration is not long enough to encapsulate the words, put them out to the right.
I need the font to stay the same size so this is more about placement or allowing to spill than autofitting. I tied .WordWrap = False, but it doesn't seem to do it.

Is there a way to do this dynamically as part of the code or should I make it a choice on the userform instead?

Thanks as always for your expert help!

1655761140826.png
1655761218436.png
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
GeeWhiz 7, I've looked this problem and I don't see reason to move text outside of shape.
More elegantly will be to do that with "Allow text to overflow shape".
I've explore some possibilities and it looks like this.
Capture.JPG
 
Upvote 0
EXCEL MAX said:
GeeWhiz 7, I've looked this problem and I don't see reason to move text outside of shape.
More elegantly will be to do that with "Allow text to overflow shape".
I've explore some possibilities and it looks like this.
View attachment 67828
Click to expand...
Thank you for this, I had tried something like it before but it didn't seem to work, but you're pointing it out made me dig deeper. Took me a little bit to figure out as the .HorizontalOverflow property was a TextFrame2 property and the others a TextFrame property and only happens if .WordWrap = False.

So now I will use the "allow text to overflow shape" as a default (last Else in my ElseIf) if user doesn't select a Text location from the form which leaves a good solution!

1656077393948.png
 
Upvote 0
If you attempt to use the "allow text to overflow shape" here is example how it may be used.
VBA Code: 
Sub AdjustShape()
      
   Dim vA As Variant, vWS As Worksheet, vRng As Range
   Dim vN As Integer
   Dim vShLeft, vShTop, vShWidth, vShHeight, vSh As Shape
   
   Application.ScreenUpdating = False
   vA = Array(20, 50, 150)
   Set vWS = ActiveSheet
   vWS.Range("B2").Resize(UBound(vA) + 1, 1) = Application.Transpose(vA)
   Set vRng = vWS.Range("B2").Resize(UBound(vA) + 1, 1)
   tLabel = "Long Words Here"
   For vN = 1 To UBound(vA) + 1
      With vRng.Cells(vN)
         vShLeft = .Left + .Width
         vShTop = .Top
         vShWidth = .Value
         vShHeight = .Height
      End With
      Set vSh = vWS.Shapes.AddShape( _
      msoShapeRectangle, vShLeft, vShTop, vShWidth, vShHeight)
      With vSh
         .TextFrame2.WordWrap = False
         .Fill.ForeColor.RGB = RGB(237, 125, 49)
         With .TextFrame
            .HorizontalOverflow = xlOartHorizontalOverflowOverflow
            .Characters.Text = tLabel
            With .Characters.Font
               .Color = RGB(0, 0, 0)
               .FontStyle = "Bold"
               .Size = 12
             End With
            .HorizontalAlignment = xlHAlignLeft
            .VerticalAlignment = xlVAlignCenter
         End With
         .Line.Visible = True
      End With
   Next vN
   Application.ScreenUpdating = True
   
End Sub
 
Last edited:
Upvote 0
EXCEL MAX said:
If you attempt to use the "allow text to overflow shape" here is example how it may be used.
VBA Code: 
Sub AdjustShape()
    
   Dim vA As Variant, vWS As Worksheet, vRng As Range
   Dim vN As Integer
   Dim vShLeft, vShTop, vShWidth, vShHeight, vSh As Shape
 
   Application.ScreenUpdating = False
   vA = Array(20, 50, 150)
   Set vWS = ActiveSheet
   vWS.Range("B2").Resize(UBound(vA) + 1, 1) = Application.Transpose(vA)
   Set vRng = vWS.Range("B2").Resize(UBound(vA) + 1, 1)
   tLabel = "Long Words Here"
   For vN = 1 To UBound(vA) + 1
      With vRng.Cells(vN)
         vShLeft = .Left + .Width
         vShTop = .Top
         vShWidth = .Value
         vShHeight = .Height
      End With
      Set vSh = vWS.Shapes.AddShape( _
      msoShapeRectangle, vShLeft, vShTop, vShWidth, vShHeight)
      With vSh
         .TextFrame2.WordWrap = False
         .Fill.ForeColor.RGB = RGB(237, 125, 49)
         With .TextFrame
            .HorizontalOverflow = xlOartHorizontalOverflowOverflow
            .Characters.Text = tLabel
            With .Characters.Font
               .Color = RGB(0, 0, 0)
               .FontStyle = "Bold"
               .Size = 12
             End With
            .HorizontalAlignment = xlHAlignLeft
            .VerticalAlignment = xlVAlignCenter
         End With
         .Line.Visible = True
      End With
   Next vN
   Application.ScreenUpdating = True
 
End Sub
Click to expand...
Thank you, that works nicely for sure and you found the enumeration I was looking and looking for!

It takes me a bit to understand some of the other parts of what your code is doing, but it definitely helps me with the overflow of the textframe. Here is how I implemented it for now in my code. I'm now trying to figure out if there is an enumeration that will allow me to Offset the text/TextFrame from the shape so I can put it above, below, etc by choice...documentation seems lacking...

If I can find it, then I will make it a choice and put the Overflow enumeration as a default unless user selects to offset. Something like the image below, by not checking Text Location option button, an overflow of the text would be default.

VBA Code: 
 If TaskCheck = True Then
       
        Set S = ws.Shapes.AddShape(Type:=msoShapeRectangle, _
        Left:=c.Left, _
        Top:=c.Top, _
        Width:=c.Width + Dur, _
        Height:=c.Height)
                
        S.Fill.ForeColor.RGB = RGB(R, G, B)
        S.TextFrame2.WordWrap = False
       
        With S.TextFrame
                       
            .Characters.Text = tLabel
            .Characters.Font.ColorIndex = 3
            .Characters.Font.Color = RGB(0, 0, 0)
            .Characters.Font.Name = "Century Gothic"
            .Characters.Font.FontStyle = "Bold"
            .Characters.Font.Size = 12
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
            .HorizontalOverflow = xlOartHorizontalOverflowOverflow
           
        End With

        S.Select
1656094421334.png
 
Upvote 0
GeeWhiz7 said:
Thank you, that works nicely for sure and you found the enumeration I was looking and looking for!

It takes me a bit to understand some of the other parts of what your code is doing, but it definitely helps me with the overflow of the textframe. Here is how I implemented it for now in my code. I'm now trying to figure out if there is an enumeration that will allow me to Offset the text/TextFrame from the shape so I can put it above, below, etc by choice...documentation seems lacking...

If I can find it, then I will make it a choice and put the Overflow enumeration as a default unless user selects to offset. Something like the image below, by not checking Text Location option button, an overflow of the text would be default.

VBA Code: 
 If TaskCheck = True Then
      
        Set S = ws.Shapes.AddShape(Type:=msoShapeRectangle, _
        Left:=c.Left, _
        Top:=c.Top, _
        Width:=c.Width + Dur, _
        Height:=c.Height)
               
        S.Fill.ForeColor.RGB = RGB(R, G, B)
        S.TextFrame2.WordWrap = False
      
        With S.TextFrame
                      
            .Characters.Text = tLabel
            .Characters.Font.ColorIndex = 3
            .Characters.Font.Color = RGB(0, 0, 0)
            .Characters.Font.Name = "Century Gothic"
            .Characters.Font.FontStyle = "Bold"
            .Characters.Font.Size = 12
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
            .HorizontalOverflow = xlOartHorizontalOverflowOverflow
          
        End With

        S.Select
View attachment 67878
Click to expand...
Here is how I figured out to offset the text. It's not really offsetting the textframe, but deleting that text and putting the equivalent text in a cell above/below, etc.
So this works pretty well. Default is your idea for spilling out of shape and if user selects any of the other choices then it uses text in a cell.

VBA Code: 
If TextACheck = True Then
        ActiveCell.Offset(-1, 0) = tLabel
        S.TextFrame2.DeleteText
        
        ElseIf TextBCheck = True Then
    
            ActiveCell.Offset(1, 0) = tLabel
            S.TextFrame2.DeleteText
        
        ElseIf TextLtCheck = True Then
    
            ActiveCell.Offset(0, -1) = tLabel
            S.TextFrame2.DeleteText
        
        ElseIf TextRtCheck = True Then
    
            ActiveCell.Offset(0, 1) = tLabel
            S.TextFrame2.DeleteText
        
        ElseIf TextCentCheck = True Then
        'If none of these are true then it should just follow the placement below in S.Textframe With
    
        Else
    
    End If
 
Upvote 0
Good simple idea, if you can set text to the cells,
but if you need to resize cells around shape, or to resize shape itself, you will have problem to get universal solution.
Here is example what properties you need to take care while choosing text position around shape.
I know, you are smart boy, you will understand code, but for anyone who do not understand,
I suggest to create userform with commandbutton and
4 optionbuttons (named "optAbove", "optRight", "optBelow", "optLeft") and try this code.
VBA Code: 
Private Sub UserForm_Initialize()
   optLeft = True
End Sub
Private Sub CommandButton1_Click()
   Call SetShapeTextFramePosition
End Sub

Sub SetShapeTextFramePosition()
   Dim vWS As Worksheet, vC As Range, Dur, tLabel As String, vA
   Dim vShLeft, vShTop, vShWidth, vShHeight, vSh As Shape

   Application.ScreenUpdating = False
   Set vWS = ActiveSheet
   Set vC = vWS.Range("E5")
   Dur = 123.45
   tLabel = "Long Words Here"
   With vC
      vShLeft = .Left + .Width + Dur
      vShTop = .Top
      vShWidth = Dur
      vShHeight = .Height
   End With
   Set vSh = vWS.Shapes.AddShape( _
      msoShapeRectangle, vShLeft, vShTop, vShWidth, vShHeight)
   vSh.TextFrame2.WordWrap = False
   With vSh.TextFrame
      .Characters.Text = tLabel
      .Characters.Font.ColorIndex = 3
      .Characters.Font.Name = "Century Gothic"
      .Characters.Font.FontStyle = "Bold"
      .Characters.Font.Size = 12
      .VerticalOverflow = xlOartVerticalOverflowOverflow
      .HorizontalOverflow = xlOartHorizontalOverflowOverflow
      Select Case ActiveOption
         Case "optAbove"
            .VerticalAlignment = xlVAlignBottom
            .HorizontalAlignment = xlHAlignCenter
            .MarginBottom = vShHeight + .Characters.Font.Size / 2
         Case "optRight"
            .VerticalAlignment = xlVAlignCenter
            .HorizontalAlignment = xlHAlignLeft
            .MarginLeft = vShWidth + .Characters.Font.Size
         Case "optBelow"
            .VerticalAlignment = xlVAlignTop
            .HorizontalAlignment = xlHAlignCenter
            .MarginTop = vShHeight + .Characters.Font.Size / 2
         Case "optLeft"
            .VerticalAlignment = xlVAlignCenter
            .HorizontalAlignment = xlHAlignRight
            .MarginRight = vShWidth + .Characters.Font.Size
      Case Else
      End Select
   End With
   Application.ScreenUpdating = True
End Sub

Function ActiveOption()
   vA = Array("optAbove", "optRight", "optBelow", "optLeft")
   For vN = 0 To UBound(vA)
      If Controls(vA(vN)) Then ActiveOption = vA(vN): Exit Function
   Next vN
End Function
 
Upvote 0
EXCEL MAX said:
Good simple idea, if you can set text to the cells,
but if you need to resize cells around shape, or to resize shape itself, you will have problem to get universal solution.
Here is example what properties you need to take care while choosing text position around shape.
I know, you are smart boy, you will understand code, but for anyone who do not understand,
I suggest to create userform with commandbutton and
4 optionbuttons (named "optAbove", "optRight", "optBelow", "optLeft") and try this code.
VBA Code: 
Private Sub UserForm_Initialize()
   optLeft = True
End Sub
Private Sub CommandButton1_Click()
   Call SetShapeTextFramePosition
End Sub

Sub SetShapeTextFramePosition()
   Dim vWS As Worksheet, vC As Range, Dur, tLabel As String, vA
   Dim vShLeft, vShTop, vShWidth, vShHeight, vSh As Shape

   Application.ScreenUpdating = False
   Set vWS = ActiveSheet
   Set vC = vWS.Range("E5")
   Dur = 123.45
   tLabel = "Long Words Here"
   With vC
      vShLeft = .Left + .Width + Dur
      vShTop = .Top
      vShWidth = Dur
      vShHeight = .Height
   End With
   Set vSh = vWS.Shapes.AddShape( _
      msoShapeRectangle, vShLeft, vShTop, vShWidth, vShHeight)
   vSh.TextFrame2.WordWrap = False
   With vSh.TextFrame
      .Characters.Text = tLabel
      .Characters.Font.ColorIndex = 3
      .Characters.Font.Name = "Century Gothic"
      .Characters.Font.FontStyle = "Bold"
      .Characters.Font.Size = 12
      .VerticalOverflow = xlOartVerticalOverflowOverflow
      .HorizontalOverflow = xlOartHorizontalOverflowOverflow
      Select Case ActiveOption
         Case "optAbove"
            .VerticalAlignment = xlVAlignBottom
            .HorizontalAlignment = xlHAlignCenter
            .MarginBottom = vShHeight + .Characters.Font.Size / 2
         Case "optRight"
            .VerticalAlignment = xlVAlignCenter
            .HorizontalAlignment = xlHAlignLeft
            .MarginLeft = vShWidth + .Characters.Font.Size
         Case "optBelow"
            .VerticalAlignment = xlVAlignTop
            .HorizontalAlignment = xlHAlignCenter
            .MarginTop = vShHeight + .Characters.Font.Size / 2
         Case "optLeft"
            .VerticalAlignment = xlVAlignCenter
            .HorizontalAlignment = xlHAlignRight
            .MarginRight = vShWidth + .Characters.Font.Size
      Case Else
      End Select
   End With
   Application.ScreenUpdating = True
End Sub

Function ActiveOption()
   vA = Array("optAbove", "optRight", "optBelow", "optLeft")
   For vN = 0 To UBound(vA)
      If Controls(vA(vN)) Then ActiveOption = vA(vN): Exit Function
   Next vN
End Function
Click to expand...
I like that code, it is cleaner than mine and I did have to get rid of the text in cell way as it was having problems.
. I had been working on the idea of a separate textframe above, below etc and managed to get them to work by making the second text frame with no line and 100% transparent fill. User chooses on the form. I will made some modifications based on your code to improve mine. Funny how after I am almost complete I find/realize how to write the whole thing a little better an no so messy. Still learning…
1656185666245.png
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
If statement - offset text placement (from shape or cell)
Replies
1
Views
863
GeeWhiz7
G
A
  • Question Question
Create Generic Hyperlink to Move to "First", "Previous", "Next" and "Last" Sheet within the same Workbook using Left & Right Autoshapes.
Replies
3
Views
5K
all4excel
A

Forum statistics

Threads
1,224,824
Messages
6,181,187
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top