none
(Urgent) need a VBA code to Dynamically increase or decrease the width of the shape according to the length of shape data (text) RRS feed

  • Question

  • hi Guys

    i am completely new to VBA. it's two days which i have started studying & Learning VBA just for one pice of code. during these 2 days i have studied lots of hours & i have got headache now ! please help

    i have stopped at the final part of my macro.

    i have write a macro which cuts the word from the 1st line of the active document & pastes it in a user-created rectangle shape.

    at the end, i need after pasted the text into that shape, the horizontal width of that rectangle be automatically resized to fit the length of word inside it.

    please look at the following screenshot:

    am i in the right way:

    can len function help here? len calculates the lenght of the shape data (text insdie shape) & then set the width of the shape equals to text length plus for example 2 or 3 units?

    please write me the code. i can't myself

    thanks in advanced


    • Edited by john.s2011 Tuesday, November 4, 2014 8:14 PM
    Tuesday, November 4, 2014 8:09 PM

Answers

  • Hi John,

    Based on the description, you want to set the shape width based on the width of text inside the shape. Have you tested to use "Wrap text in shape" like figure below?

    As far as I tested, if we uncheck the option, the width of shape will fit the text's with. And here is the code for your reference:

    Sub WrapTextInShape()
    Application.ActiveDocument.Shapes(2).TextFrame.WordWrap = False
    End Sub
    

    Regards & Fei


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    • Marked as answer by john.s2011 Wednesday, November 5, 2014 10:06 AM
    Wednesday, November 5, 2014 9:21 AM
    Moderator

All replies

  • hi Guys

    i finally succeeded to write a macro for WORD 2013 which cuts one or some text & paste it into my customized shape which i had saved it as an Auto-text.

    but i have an small problem.  i need after my text is pasted into that rectangle shape, the shape wide be Fit according to the wide of my text.

    i think i need a code which examines (calculate ) the wide of my text block & then change the wide of that Auto-text rectangle  shape according to text block wide.

    may you please guide me what VBA code can do this part for me ?

    really thanks in advanced

    Thursday, October 30, 2014 6:39 AM
  • Assuming the string is all on one line, you can calculate its width with code like:

    Dim Rng As Range, sngWdth As Single
    Set Rng = Selection.Range
    With Rng
      sngWdth = .Characters.First.Information(wdHorizontalPositionRelativeToPage)
      .Collapse wdCollapseEnd
      sngWdth = .Information(wdHorizontalPositionRelativeToPage) - sngWdth
    End With
    MsgBox sngWdth

    Do note that, if the string is in a paragraph using justification, the width may not be the same as when it's in a paragraph not using justification. It is important, therefore, to use the same justification settings as your shape will use.


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Thursday, October 30, 2014 7:08 AM
    • Marked as answer by john.s2011 Thursday, October 30, 2014 7:15 AM
    • Unmarked as answer by john.s2011 Friday, October 31, 2014 6:43 PM
    Thursday, October 30, 2014 7:06 AM
  • Assuming the string is all on one line, you can calculate its width with code like:

    Dim Rng As Range, sngWdth As Single
    Set Rng = Selection.Range
    With Rng
      sngWdth = .Characters.First.Information(wdHorizontalPositionRelativeToPage)
      .Collapse wdCollapseEnd
      sngWdth = .Information(wdHorizontalPositionRelativeToPage) - sngWdth
    End With
    MsgBox sngWdth

    Do note that, if the string is in a paragraph using justification, the width may not be the same as when it's in a paragraph not using justification. It is important, therefore, to use the same justification settings as your shape will use.


    Cheers
    Paul Edstein
    [MS MVP - Word]


    Hi again

    unfortunately your code doesn't do what i need.

    to clarify here it's my need:

     


    • Edited by john.s2011 Friday, October 31, 2014 6:53 PM
    Thursday, October 30, 2014 7:15 AM
  • The method I posted is correct for what it purports to demonstrate, which is how to calculate the width of a selected string. Instead of glibly saying "your code doesn't do what i need", you should post the code that shows how you are implementing the method. That, after all, is where the problem lies.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Wednesday, November 5, 2014 5:33 AM
  • I have already explained how to calculate the string width in this thread:
    https://social.msdn.microsoft.com/Forums/office/en-US/1f27edb1-4514-485b-9ab7-a8bb5bbbfb9c/vba-code-to-fit-the-wide-of-a-shape-according-to-wide-of-the-shape-text-shape-data?forum=worddev. Despite your assertion it "doesn't do what i need" in that thread, the fact remains that it is the correct way to do the calculation.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Wednesday, November 5, 2014 5:33 AM
  • The method I posted is correct for what it purports to demonstrate, which is how to calculate the width of a selected string. Instead of glibly saying "your code doesn't do what i need", you should post the code that shows how you are implementing the method. That, after all, is where the problem lies.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Paul

    if you pay attention to my question title & also content, you notice that your answer is incomplete 

    i think i need a code which examines (calculate ) the wide of my text block & then change the wide of that Auto-text rectangle  shape according to text block wide."

    your answer only calculates the width, but what about rest of question?

    i myself studied & tried to add required code for the rest of the question & i used this :

          ActiveDocument.Shapes(1).Select
          Dim Rng As Range, sngWdth As Single
           Set Rng = Selection.Range
          With Rng
            sngWdth = .Characters.First.Information(wdHorizontalPositionRelativeToPage)
            .Collapse wdCollapseEnd
            sngWdth = .Information(wdHorizontalPositionRelativeToPage) - sngWdth
            End With
            ActiveDocument.Shapes(1).Width = sngWdth

    i don't know is the last line the one which i need ?

    but this is the result which is ridiculous & definitely not what i needed.

    Paul excuse me but i am a network Administrator & too busy. i don't have enough time to learn VBA for now ( although i have been very interested in VBA in these days after studying it ), so i asked for the final answer.

     


    • Edited by john.s2011 Wednesday, November 5, 2014 9:00 AM
    Wednesday, November 5, 2014 8:58 AM
  • I have already explained how to calculate the string width in this thread:
    https://social.msdn.microsoft.com/Forums/office/en-US/1f27edb1-4514-485b-9ab7-a8bb5bbbfb9c/vba-code-to-fit-the-wide-of-a-shape-according-to-wide-of-the-shape-text-shape-data?forum=worddev. Despite your assertion it "doesn't do what i need" in that thread, the fact remains that it is the correct way to do the calculation.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    hi again

    Question
    You cannot vote on your own post
    0
    The method I posted is correct for what it purports to demonstrate, which is how to calculate the width of a selected string. Instead of glibly saying "your code doesn't do what i need", you should post the code that shows how you are implementing the method. That, after all, is where the problem lies.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Paul

    if you pay attention to my question title & also content, you notice that your answer is incomplete 

    i think i need a code which examines (calculate ) the wide of my text block & then change the wide of that Auto-text rectangle  shape according to text block wide."

    your answer only calculates the width, but what about rest of question?

    i myself studied & tried to add required code for the rest of the question & i used this :

          ActiveDocument.Shapes(1).Select
          Dim Rng As Range, sngWdth As Single
           Set Rng = Selection.Range
          With Rng
            sngWdth = .Characters.First.Information(wdHorizontalPositionRelativeToPage)
            .Collapse wdCollapseEnd
            sngWdth = .Information(wdHorizontalPositionRelativeToPage) - sngWdth
            End With
            ActiveDocument.Shapes(1).Width = sngWdth

    i don't know is the last line the one which i need ?

    but this is the result which is ridiculous & definitely not what i needed.

    Paul excuse me but i am a network Administrator & too busy. i don't have enough time to learn VBA for now ( although i have been very interested in VBA in these days after studying it ), so i asked for the final answer.

     

    Wednesday, November 5, 2014 9:03 AM
  • Hi John,

    Based on the description, you want to set the shape width based on the width of text inside the shape. Have you tested to use "Wrap text in shape" like figure below?

    As far as I tested, if we uncheck the option, the width of shape will fit the text's with. And here is the code for your reference:

    Sub WrapTextInShape()
    Application.ActiveDocument.Shapes(2).TextFrame.WordWrap = False
    End Sub
    

    Regards & Fei


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    • Marked as answer by john.s2011 Wednesday, November 5, 2014 10:06 AM
    Wednesday, November 5, 2014 9:21 AM
    Moderator
  • Hi John,

    Based on the description, you want to set the shape width based on the width of text inside the shape. Have you tested to use "Wrap text in shape" like figure below?

    As far as I tested, if we uncheck the option, the width of shape will fit the text's with. And here is the code for your reference:

    Sub WrapTextInShape()
    Application.ActiveDocument.Shapes(2).TextFrame.WordWrap = False
    End Sub
    

    Regards & Fei


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Hi Fei

    wow my God thank you veryyyyyyyyyyyyyyyyyyyyyyyy much  

    Great Great Great . i don't know how to thanks you. i don't believe which this simple solution i could get it.

    it was an urgent need & it's 3 days which i have started studying & learning VBA from start but i wasn't able to get this.

    really Appreciate your kknowledge. you really helped me & saved me from headache.

    best regaaaaaaaaaaaaaaaaaaaaaaaaards

    Wednesday, November 5, 2014 10:09 AM
  • And here is my Lovely macro which exactly performs what i need. i paste it here for those who which may require such stuff in the future:

    Sub MakeFirstLineAsTitle()
    'imagin there are some lines a in Document & you place cursor in first line _
     ' which is going to be Heading (Title)
    'go to end of the selected line which is going to be Title.
              Selection.EndKey Unit:=wdLine
    'cursor goes to the start of the next bottom line:
              Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1
              Selection.TypeParagraph
              Selection.TypeParagraph
              Selection.TypeParagraph
    ' come back to the top line
              Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=4
     ' go to the beginning & then select entire line:
             Selection.HomeKey Unit:=wdLine
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
     ' change the font of the selected text block:
            With Selection.Font
             .Size = 20
             .Bold = True
             .Color = wdColorRed
           End With
    ' cut the selected text block :
            ActiveDocument.ActiveWindow.Selection.Cut
     ' insert the _red_box shape in the cutted text block location:
            Application.Templates( _
     "C:\Users\Administrator\AppData\Roaming\Microsoft\Templates\Normal.dotm") _
     .BuildingBlockEntries("_red_box").insert where:=Selection.Range, RichText:=True
            ' code to select the redbox:
            ActiveDocument.Shapes(1).Select
            ' Or  ActiveDocument.Shapes("_red_box").Select
                'code to paste the cutted text into this rectangle
          ActiveDocument.ActiveWindow.Selection.Paste
          ' now yet _red_box is selected, first we must make cursor select the text inside the _red_box '    'select entire text block
          ActiveDocument.Shapes(1).TextFrame.TextRange.Select
          'Align the text as center
          Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
          ActiveDocument.Shapes(1).Select
          ' now a code to adjust the width of the _red_box according to text width:
          Application.ActiveDocument.Shapes(1).TextFrame.WordWrap = False
          Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=3
    End Sub

    :-)  regards


    • Edited by john.s2011 Wednesday, November 5, 2014 1:48 PM
    Wednesday, November 5, 2014 1:47 PM
  • i am a network Administrator & too busy. i don't have enough time to learn VBA for now


    In that case, you should not be posting here - this is a Developer's forum (i.e. for those with much more than just a passing interest in Development).

    As I said, the problem was with your implementation. You should have either:
    a) measured the text width before adding it to the textbox; or
    b) as your original description showed, used had a textbox started wider than the text.
    The problem was that you ignored the clearly stated the proviso that "the string is all on one line". You could only get the results you obtained if the string was not all on one line (which will happen if the textbox is too narrow for the text). Ensuring the textbox was wide enough to start with is a trivial coding exercise.

    In any event, might I suggest that you have no need of a textbox for what you're trying to achieve and a far better way to do so is to edit Word's 'Title' Style (or any other Style you deem appropriate) to conform to your requirements, then apply that to the paragraphs concerned. Something your textbox won't do,that using a Style enables quite easily, is ensure the title stays on the same page and in the same position vis-a-vis the text to which it relates.

    The following macro can be used to edit Word's 'Title' Style. There's far more code than is necessary to do what you've described (and most of it is simply set to use Word's defaults), but the extra gives you an idea of how many parameters there are that can be set. For example, if you want to ensure the title always appears at the top of the page, you could change 'PageBreakBefore = False' to 'PageBreakBefore = True'. You only need run this code once for a document or its template. If you update the document template, you don't even need this code thereafter, since any new documents based on the same template will inherit these properties.

    Sub RedefineTitleStyle()
    With ActiveDocument.Styles("Title")
      .NoSpaceBetweenParagraphsOfSameStyle = True
      With .Font
        .Size = 20
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0.25
        .Scaling = 100
        .Kerning = 0
        .Animation = wdAnimationNone
        .Ligatures = wdLigaturesNone
        .NumberSpacing = wdNumberSpacingDefault
        .NumberForm = wdNumberFormDefault
        .StylisticSet = wdStylisticSetDefault
        .ContextualAlternates = 0
      End With
      With .ParagraphFormat
        .TabStops.ClearAll
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 12
        .SpaceBeforeAuto = False
        .SpaceAfter = 12
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .Alignment = wdAlignParagraphCenter
        .WidowControl = True
        .KeepWithNext = True
        .KeepTogether = True
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = CentimetersToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
        With .Shading
          .Texture = wdTextureNone
          .ForegroundPatternColor = wdColorAutomatic
          .BackgroundPatternColor = wdColorAutomatic
        End With
        With .Borders(wdBorderLeft)
          .LineStyle = wdLineStyleSingle
          .LineWidth = wdLineWidth225pt
          .Color = wdColorRed
        End With
        With .Borders(wdBorderRight)
          .LineStyle = wdLineStyleSingle
          .LineWidth = wdLineWidth225pt
          .Color = wdColorRed
        End With
        With .Borders(wdBorderTop)
          .LineStyle = wdLineStyleSingle
          .LineWidth = wdLineWidth225pt
          .Color = wdColorRed
        End With
        With .Borders(wdBorderBottom)
          .LineStyle = wdLineStyleSingle
          .LineWidth = wdLineWidth225pt
          .Color = wdColorRed
        End With
        With .Borders
          .DistanceFromTop = 24
          .DistanceFromLeft = 3
          .DistanceFromBottom = 24
          .DistanceFromRight = 3
          .Shadow = False
        End With
      End With
    End With
    End Sub

    Having edited/redefined the Title Style, all you need do from then on is to place the insertion point in any given paragraph, then apply the Style. By default, the Title Style's paragraph border will occupy the print width. Using the following FormatTitle macro to do that will adjust the left & paragraph indents to keep border width to a minimum. If you subsequently edit the text, simply re-run the FormatTitle macro.

    Sub FormatTitle()
    Application.ScreenUpdating = False
    Dim sngWdth As Single, sngPgWdth As Single
    With Selection
      With .Sections(1).PageSetup
        sngPgWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
      End With
      With .Paragraphs(1)
        .Style = "Normal"
        .Style = "Title"
        sngWdth = .Range.Characters.Last.Information(wdHorizontalPositionRelativeToPage) - _
          .Range.Characters.First.Information(wdHorizontalPositionRelativeToPage)
        .LeftIndent = (sngPgWdth - sngWdth) / 2 - .Borders.DistanceFromLeft
        .RightIndent = (sngPgWdth - sngWdth) / 2 - .Borders.DistanceFromRight
      End With
    End With
    Application.ScreenUpdating = True
    End Sub

    Finally, unlike your code (which relies on Word 2013's "_red_box" Building Block Entry), the above code works with other Word versions too.



    Cheers
    Paul Edstein
    [MS MVP - Word]

    Thursday, November 6, 2014 6:38 AM