Help with Macros

Z

zinah

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

I have below macro which work successfully and created required box and loop through all the data


Code: 
Sub add_EMPLOYEE_rectangles()Set aSht = ActiveSheet
Set rSht = Sheets("Role Scorecard")
    rSht.Activate


Call reset_EMPLOYEE_rectangles
Dim galaxyF As Shape
Dim Empl_Lbl, Empl_Txt As Shape
    Set galaxyF = rSht.Shapes("Galaxy_frame")


Dim eCnt As Long, e As Long, pix As Long
pix = 72  'use to convert inches to pixels
    eCnt = 17  'number of data boxes in Employee Info section


Dim el, et, ew, eh As Single
Dim etl, ett, etw, eth As Single


'''BUILD THE eCnt LABEL BOX'''


For e = 1 To eCnt


    ew = galaxyF.Width / 2
    eh = galaxyF.Height / eCnt
    el = galaxyF.Left
    et = galaxyF.Top + (eh * (e - 1))
Set Empl_Lbl = rSht.Shapes.AddShape(msoShapeRectangle, el, et, ew, eh)
With Empl_Lbl
    .Name = "Empl_" & e & "_Lbl"
    .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.05 * pix
    .TextFrame.MarginRight = 0.15 * pix
    .TextFrame.MarginTop = 0.05 * pix
    .TextFrame.MarginBottom = 0.05 * pix
    .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
    .TextFrame2.VerticalAnchor = msoAnchorMiddle
    .TextFrame2.AutoSize = msoAutoSizeNone
    .TextFrame.VerticalOverflow = xlOartVerticalOverflowOverflow
    .TextFrame.HorizontalOverflow = xlOartHorizontalOverflowOverflow
    .TextFrame2.WordWrap = msoTrue


Dim shp As Shape
Dim lblRng As Range
    
        Set lblRng = [LabelRange]
        i = 0
        
        For lbl = lblRng.Row To (lblRng.Row + lblRng.Rows.Count - 1)
        i = i + 1
        
        For Each Empl_Lbl In ActiveSheet.Shapes
        If InStr(1, Empl_Lbl.Name, i) > 0 Then
            Set shp = ActiveSheet.Shapes(i)
            .TextFrame2.TextRange.Characters.Text = Cells(lbl, lblRng.Column).Value 
            .TextFrame2.TextRange.Font.Bold = msoTrue
    
            End If
        Next Empl_Lbl
        
      Next lbl


End With




aSht.Activate


Next






End Sub

However, when I add below macro it bugs out "run-time error 424, Object required", can you help me fixing this macro?

Code: 
'''BUILD THE eCnt TEXT BOX'''

    etw = galaxyF.Width - Empl_Lbl.Width
    eth = Empl_Lbl.Height
    etl = Empl_Lbl.Left + Empl_Lbl.Width
    ett = Empl_Lbl.Top
Set Empl_Txt = rSht.Shapes.AddShape(msoShapeRectangle, etl, ett, etw, eth)


With Empl_Txt
    .Name = "Empl_" & e & "_Txt"
    .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 = msoAnchorMiddle
    .TextFrame2.AutoSize = msoAutoSizeNone
    .TextFrame.VerticalOverflow = xlOartVerticalOverflowOverflow
    .TextFrame.HorizontalOverflow = xlOartHorizontalOverflowOverflow
    .TextFrame2.WordWrap = msoTrue


.TextFrame2.TextRange.Characters.Text = "TEXT " & Format(e, "00000")
    .TextFrame2.TextRange.Font.Bold = msoFalse




End With
 
Last edited by a moderator:

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
zinah said:
However, when I add below macro it bugs out "run-time error 424, Object required", can you help me fixing this macro?
Click to expand...
On what line of code does it "bug out"?

Also, where inside your macro are you putting this second code snippet?
 
Upvote 0
Hi,

Here are my answers:
On what line of code does it "bug out"? this line:etw = galaxyF.Width - Empl_Lbl.Width


Also, where inside your macro are you putting this second code snippet? all my macros under one module and the additional macro is exactly below the first macro
Click to expand...

Here's the full macro:
Code: 
Sub add_EMPLOYEE_rectangles()Set aSht = ActiveSheet
Set rSht = Sheets("Role Scorecard")
    rSht.Activate


Call reset_EMPLOYEE_rectangles
Dim galaxyF As Shape
Dim Empl_Lbl, Empl_Txt As Shape
    Set galaxyF = rSht.Shapes("Galaxy_frame")


Dim eCnt As Long, e As Long, pix As Long
pix = 72  'use to convert inches to pixels
    eCnt = 17  'number of data boxes in Employee Info section


Dim el, et, ew, eh As Single
Dim etl, ett, etw, eth As Single


'''BUILD THE eCnt LABEL BOX'''


For e = 1 To eCnt


    ew = galaxyF.Width / 2
    eh = galaxyF.Height / eCnt
    el = galaxyF.Left
    et = galaxyF.Top + (eh * (e - 1))
Set Empl_Lbl = rSht.Shapes.AddShape(msoShapeRectangle, el, et, ew, eh)
With Empl_Lbl
    .Name = "Empl_" & e & "_Lbl"
    .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.05 * pix
    .TextFrame.MarginRight = 0.15 * pix
    .TextFrame.MarginTop = 0.05 * pix
    .TextFrame.MarginBottom = 0.05 * pix
    .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
    .TextFrame2.VerticalAnchor = msoAnchorMiddle
    .TextFrame2.AutoSize = msoAutoSizeNone
    .TextFrame.VerticalOverflow = xlOartVerticalOverflowOverflow
    .TextFrame.HorizontalOverflow = xlOartHorizontalOverflowOverflow
    .TextFrame2.WordWrap = msoTrue


Dim shp As Shape
Dim lblRng As Range
    
        Set lblRng = [LabelRange]
        i = 0
        
        For lbl = lblRng.Row To (lblRng.Row + lblRng.Rows.Count - 1)
        i = i + 1
        
        For Each Empl_Lbl In ActiveSheet.Shapes
        If InStr(1, Empl_Lbl.Name, i) > 0 Then
            Set shp = ActiveSheet.Shapes(i)
            .TextFrame2.TextRange.Characters.Text = Cells(lbl, lblRng.Column).Value '="LABEL " & e & ":"
            '.TextFrame2.TextRange.Characters.Text = Cells(lbl, lblRng.Column).Value
            .TextFrame2.TextRange.Font.Bold = msoTrue
    
            End If
        Next Empl_Lbl
        
      Next lbl


End With
Next


'''BUILD THE eCnt TEXT BOX'''


    etw = galaxyF.Width - Empl_Lbl.Width
    eth = Empl_Lbl.Height
    etl = Empl_Lbl.Left + Empl_Lbl.Width
    ett = Empl_Lbl.Top
Set Empl_Txt = rSht.Shapes.AddShape(msoShapeRectangle, etl, ett, etw, eth)


With Empl_Txt
    .Name = "Empl_" & e & "_Txt"
    .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 = msoAnchorMiddle
    .TextFrame2.AutoSize = msoAutoSizeNone
    .TextFrame.VerticalOverflow = xlOartVerticalOverflowOverflow
    .TextFrame.HorizontalOverflow = xlOartHorizontalOverflowOverflow
    .TextFrame2.WordWrap = msoTrue


.TextFrame2.TextRange.Characters.Text = "TEXT " & Format(e, "00000")
    .TextFrame2.TextRange.Font.Bold = msoFalse




End With






aSht.Activate




End Sub
 
Last edited by a moderator:
Upvote 0
@zinah
When posting code please use code tags, the # icon in the reply window, rather than quotes.
Cheers
 
Upvote 0
@Fluff
Thank you for your input and edit, I'll make sure using code tags in future.
 
Upvote 0
zinah said:
Here's the full macro:
Click to expand...
Snippets from your code and comments...

Rich (BB code): 
Dim Empl_Lbl, Empl_Txt As Shape
The above line of code declares Empl_Lbl as a Variant, not as a Shape. In VBA, you must declare each variable individually as to its data type or it will default to Variant. That is not a source of your error, though, and is probably not harmful, just slightly inefficient. The above line of code should be declared this way...

Dim Empl_Lbl As Shape, Empl_Txt As Shape




Rich (BB code): 
For Each Empl_Lbl In ActiveSheet.Shapes
  If InStr(1, Empl_Lbl.Name, i) > 0 Then
    Set shp = ActiveSheet.Shapes(i)
    .TextFrame2.TextRange.Characters.Text = Cells(lbl, lblRng.Column).Value '="LABEL " & e & ":"
    '.TextFrame2.TextRange.Characters.Text = Cells(lbl, lblRng.Column).Value
    .TextFrame2.TextRange.Font.Bold = msoTrue
  End If
Next Empl_Lbl
This next one is probably the source of your error. Here you are reusing the Empl_Lbl variable as the iteration variable in a For..Next loop. Once that loop has completed, that variable is probably not referencing the Shape you expect it to be referencing when you try to execute this line of code which follows it...

etw = galaxyF.Width - Empl_Lbl.Width
 
Last edited:
Upvote 0
THANK YOU so much Rick for your clarification and walking me through the macro in depth. I'm so fresh to the macro world and started recently. But with the members of this valuable website I believe my learning journey would be easier.

Once again thank you and appreciate your time!
Have a good one.
 
Upvote 0
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
Set Characters and Lines Limit in a textbox
Replies
2
Views
1K
zinah
Z

Forum statistics

Threads
1,223,275
Messages
6,171,121
Members
452,381
Latest member
Nova88

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