Set Characters and Lines Limit in a textbox

Z

zinah

Active Member
Joined
Nov 28, 2018
Messages
368
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have below macro which creates text boxes in a template, these text boxes depends on number of goals which it should not exceed 5 goals. What I need is to do below:

- Set the limit of characters /lines in each box to be 48 characters and 8 lines and if the characters & lines exceeded this limit, then creates a line that has this "check goals for further info"
- If number of goals are less than 5 then show exactly number of goals and this should fit the limit I have set which is "Goals_frame"

Can anyone help?

This macro is to create the boxes

Code: 
Sub add_GOALS_rectangle()    Set aSht = ActiveSheet
    Set rSht = Sheets("Role Scorecard")
    
    rSht.Activate
Call reset_GOALS_rectangles
Dim goalsF As Shape, goalsR As Shape
Dim goalsObj, goalsOut, goalsCat, goalsPrg As Shape
    Set goalsF = rSht.Shapes("Goals_frame")


Dim gCnt As Long, g As Long, pix As Long
pix = 72  'use to convert inches to pixels
    gCnt = 100  'supposed to be the goals count, needs to become a formula
    If gCnt > 5 Then gCnt = 5


Dim l, t, w, h As Single
Dim gl, gt, gw, gh As Single
Dim objTxt, objLbl, outTxt, outLbl As String
Dim catTxt, prgTxt, prgLbl As String


'''NEED TO START LOOP HERE ... LOOPS THROUGH EACH GOAL UP TO gCnt VALUE'''
For g = 1 To gCnt
'all of the "txt" variables need to referene the spreadsheet...'




    
    objLbl = "Objective: " & Chr(10)
    outLbl = "Metrics/Outcomes: " & Chr(10)
    'objTxt = "Hi! I am an exampl Objective" & Chr(10) & "Look at how well I am written,... super well! Look at how well I am written,... super well! Look at how well I am written,... super well! Look at how well I am written,... super well!"
    'objTxt = Sheets("ref.").[G_Obj].Offset(1, 0).Value
    'outTxt = "Yo, yo, yo! .... " & Chr(10) & Chr(149) & " metric 1" & Chr(10) & Chr(149) & " metric 2" & Chr(10) & Chr(149) & " metric 3"
    'outTxt = Sheets("ref.").[G_Outc].Offset(1, 0).Value
    'catTxt = "Core Responsibilities"
     prgLbl = "Progress Notes: "
    'prgTxt = "TRUE"
     prgTxt = Sheets("ref.").[G_Prog].Offset(1, 0).Value
    'If Sheets("ref.").[G_Prog].Offset(1, 0).Value = "NO" Then >>>> "set the color Red if NO"
    '    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
 
 'Call popultate_obj_txt




'''BUILD EACH gCnt FRAME'''
    w = goalsF.Width
    h = goalsF.Height / gCnt
    l = goalsF.Left
    t = goalsF.Top + (h * (g - 1))
Set goalsR = rSht.Shapes.AddShape(msoShapeRectangle, l, t, w, h)
With goalsR
    .Name = "Goal_" & g & "_Row"
    .Placement = xlFreeFloating
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Fill.Visible = msoFalse
    .Line.ForeColor.RGB = RGB(100, 100, 100)
    
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
    .TextFrame2.TextRange.Font.Size = 8
    .TextFrame2.TextRange.Font.Name = "Tahoma"
    .TextFrame.MarginLeft = 0.5 * pix
    .TextFrame.MarginRight = 0.05 * pix
    .TextFrame.MarginTop = 0.05 * pix
    .TextFrame.MarginBottom = 0.05 * pix
    
    '.TextFrame2.TextRange.Characters.Text = objLbl & objTxt & Chr(10) & Chr(10) & outLbl & outTxt
    '.TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, objLbl), Len(objLbl)).Font.Bold = True
    '.TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, outLbl), Len(outLbl)).Font.Bold = True
End With




'''BUILD THE gCnt CATEGORY BOX'''
    gl = goalsR.Left
    gt = goalsR.Top
    gw = 0.4 * pix
    gh = goalsR.Height
Set goalsCat = rSht.Shapes.AddShape(msoShapeRectangle, gl, gt, gw, gh)
With goalsCat
    .Name = "Goal_" & g & "_Cat"
    .Placement = xlFreeFloating
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Fill.Visible = msoFalse
    .Line.ForeColor.RGB = RGB(100, 100, 100)
    
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
    .TextFrame2.TextRange.Font.Size = 8
    .TextFrame2.TextRange.Font.Name = "Tahoma"
    .TextFrame.MarginLeft = 0 * pix
    .TextFrame.MarginRight = 0 * pix
    .TextFrame.MarginTop = 0 * pix
    .TextFrame.MarginBottom = 0 * pix
    .TextFrame2.TextRange.Font.Bold = msoFalse
    .TextFrame2.Orientation = msoTextOrientationUpward
    .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
    .TextFrame2.VerticalAnchor = msoAnchorMiddle
    .TextFrame2.AutoSize = msoAutoSizeNone
    .TextFrame.VerticalOverflow = xlOartVerticalOverflowOverflow
    .TextFrame.HorizontalOverflow = xlOartHorizontalOverflowOverflow
    .TextFrame2.WordWrap = msoTrue


.TextFrame2.TextRange.Characters.Text = catTxt
End With




'''BUILD THE gCnt PROGRESS NOTE BOX'''
    gw = 0.4 * pix
    gh = goalsR.Height
    gl = goalsR.Left + goalsR.Width - gw
    gt = goalsR.Top
Set goalsPrg = rSht.Shapes.AddShape(msoShapeRectangle, gl, gt, gw, gh)
With goalsPrg
    .Name = "Goal_" & g & "_Prg"
    .Placement = xlFreeFloating
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Fill.Visible = msoFalse
    .Line.ForeColor.RGB = RGB(100, 100, 100)
    
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
    .TextFrame2.TextRange.Font.Size = 8
    .TextFrame2.TextRange.Font.Name = "Tahoma"
    .TextFrame.MarginLeft = 0 * pix
    .TextFrame.MarginRight = 0 * pix
    .TextFrame.MarginTop = 0 * pix
    .TextFrame.MarginBottom = 0 * pix
    .TextFrame2.TextRange.Font.Bold = msoFalse
    .TextFrame2.Orientation = msoTextOrientationUpward
    .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
    .TextFrame2.VerticalAnchor = msoAnchorMiddle
    .TextFrame2.AutoSize = msoAutoSizeNone
    .TextFrame.VerticalOverflow = xlOartVerticalOverflowOverflow
    .TextFrame.HorizontalOverflow = xlOartHorizontalOverflowOverflow
    .TextFrame2.WordWrap = msoTrue


.TextFrame2.TextRange.Characters.Text = prgLbl & prgTxt
    .TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, prgTxt), Len(prgTxt)).Font.Bold = True
End With




'''BUILD THE gCnt OBJECTIVE BOX'''
    gl = goalsR.Left + goalsCat.Width
    gt = goalsR.Top
    gw = (goalsR.Width - goalsCat.Width - goalsPrg.Width) / 2
    gh = goalsR.Height
Set goalsObj = rSht.Shapes.AddShape(msoShapeRectangle, gl, gt, gw, gh)
With goalsObj
    .Name = "Goal_" & g & "_Obj"
    .Placement = xlFreeFloating
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Fill.Visible = msoFalse
    '.Line.ForeColor.RGB = RGB(100, 100, 100)
    .Line.Visible = False
    
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
    .TextFrame2.TextRange.Font.Size = 8
    .TextFrame2.TextRange.Font.Name = "Tahoma"
    .TextFrame.MarginLeft = 0.15 * pix
    .TextFrame.MarginRight = 0.05 * pix
    .TextFrame.MarginTop = 0.05 * pix
    .TextFrame.MarginBottom = 0.05 * pix
    .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
    .TextFrame2.VerticalAnchor = msoAnchorTop
    .TextFrame2.AutoSize = msoAutoSizeNone
    .TextFrame.VerticalOverflow = xlOartVerticalOverflowOverflow
    .TextFrame.HorizontalOverflow = xlOartHorizontalOverflowOverflow
    .TextFrame2.WordWrap = msoTrue


.TextFrame2.TextRange.Characters.Text = objLbl & objTxt
    .TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, objLbl), Len(objLbl)).Font.Bold = True
End With




'''BUILD THE gCnt OUTCOME BOX'''
    gl = goalsR.Left + goalsCat.Width + goalsObj.Width
    gt = goalsR.Top
    gw = (goalsR.Width - goalsCat.Width - goalsPrg.Width) / 2
    gh = goalsR.Height
Set goalsOut = rSht.Shapes.AddShape(msoShapeRectangle, gl, gt, gw, gh)
With goalsOut
    .Name = "Goal_" & g & "_Out"
    .Placement = xlFreeFloating
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Fill.Visible = msoFalse
    '.Line.ForeColor.RGB = RGB(100, 100, 100)
    .Line.Visible = False
    
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
    .TextFrame2.TextRange.Font.Size = 8
    .TextFrame2.TextRange.Font.Name = "Tahoma"
    .TextFrame.MarginLeft = 0.15 * pix
    .TextFrame.MarginRight = 0.05 * pix
    .TextFrame.MarginTop = 0.05 * pix
    .TextFrame.MarginBottom = 0.05 * pix
    .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
    .TextFrame2.VerticalAnchor = msoAnchorTop
    .TextFrame2.AutoSize = msoAutoSizeNone
    .TextFrame.VerticalOverflow = xlOartVerticalOverflowOverflow
    .TextFrame.HorizontalOverflow = xlOartHorizontalOverflowOverflow
    .TextFrame2.WordWrap = msoTrue


.TextFrame2.TextRange.Characters.Text = outLbl & outTxt
    .TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, outLbl), Len(outLbl)).Font.Bold = True
End With


goalsR.ZOrder msoBringToFront
Next g


aSht.Activate
End Sub


And this macro is to populate the text of goals into boxes

Code: 
Private Sub popultate_obj_txt()    Set aSht = ActiveSheet
    Set rSht = Sheets("Role Scorecard")


'Dim oCnt As Long, o As Long >>>set the limit of objectives count
Dim shp As Shape
Dim ObjRng As Range, MetRng As Range, catRng As Range
Dim objLbl As Shape, outLbl As Shape, catLbl As Shape


'oCnt = 16
'If oCnt > 5 Then oCnt = 5


    Set ObjRng = Sheets("ref.").[ObjRange]
    Set MetRng = Sheets("ref.").[MetRange]
    Set numRng = Sheets("ref.").[NumRange]
    Set catRng = Sheets("ref.").[CatRange]
'For o = 1 To oCnt


 '   i = 0
    
For lbl = ObjRng.Row To (ObjRng.Row + ObjRng.Rows.Count - 1)
    i = i + 1
    
    For Each shp In ActiveSheet.Shapes
    If InStr(1, shp.Name, "Goal_" & i & "_Obj") > 0 Then
        With shp
            .TextFrame2.TextRange.Characters.Text = Sheets("ref.").Cells(lbl, numRng.Column) & " " & "Objective: " & Chr(10) & Sheets("ref.").Cells(lbl, ObjRng.Column).Value
            .TextFrame2.TextRange.Font.Bold = msoFalse
            .TextFrame2.TextRange.Characters(1, 14).Font.Bold = msoCTrue
            
        End With
    End If
    
    If InStr(1, shp.Name, "Goal_" & i & "_Out") > 0 Then
        With shp
        .TextFrame2.TextRange.Characters.Text = "Metrics/Outcomes: " & Chr(10) & Sheets("ref.").Cells(lbl, MetRng.Column).Value
        .TextFrame2.TextRange.Font.Bold = msoFalse
        .TextFrame2.TextRange.Characters(1, 17).Font.Bold = msoCTrue
        End With
    End If
    
    If InStr(1, shp.Name, "Goal_" & i & "_Cat") > 0 Then
        With shp
        .TextFrame2.TextRange.Characters.Text = Sheets("ref.").Cells(lbl, catRng.Column).Value
        .TextFrame2.TextRange.Font.Bold = msoFalse
        End With
    End If
    
    Next shp
Next lbl
'Next o


End Sub


Thanks!
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

Z
  • Question Question
Make the bottom border of textbox visible
2
Replies
16
Views
4K
DanteAmor
DanteAmor
Z
  • Question Question
Help with Macros
Replies
6
Views
1K
zinah
Z
Z
  • Question Question
Macro to adjust line break in a text box
Replies
0
Views
993
zinah
Z

Forum statistics

Threads
1,223,900
Messages
6,175,276
Members
452,629
Latest member
SahilPolekar

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