Link to home
Create AccountLog in
Avatar of Trygve Thayer
Trygve ThayerFlag for United States of America

asked on

Creating Macro but cannot get vb code modified

I have created a macro that should copy the contents of cell A1 and then paste it into the 10 shapes.  What appears in the macro is it has stored a static value and copies the same text into the shapes no matter what I put in Cell A1.  Could someone help me get this working.  Feeling so defeated right now.  Below is the code from the macro.

User generated image

Sub CreateBlocks()
'
' CreateBlocks Macro
' CreateBlocks
'

'
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "454545"
    ActiveSheet.Shapes.Range(Array("TextBox 111")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 564")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 565")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 566")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 567")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 568")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 569")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 570")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 571")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 572")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "454545"
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 36
        .Name = "+mn-lt"
    End With
    Range("A2").Select
End Sub


Open in new window

Avatar of Rob Henson
Rob Henson
Flag of United Kingdom of Great Britain and Northern Ireland image

Add above line 8
Dim Txt as String

Delete Line 9

Change:
Line 8:  Txt = Range("A1").Value
Line 20: Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Txt
Avatar of Trygve Thayer

ASKER

Made some progress as it did populate one shape on the sheet but the others did not change.  When we get this row working I plan to add to the macro to do additional rows.

User generated image


Sub CreateBlocks()
'
' CreateBlocks Macro
' CreateBlocks
'

'
    Dim Txt As String
    Txt = Range("A1").Value
    ActiveSheet.Shapes.Range(Array("TextBox 111")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 564")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 565")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 566")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 567")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 568")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 569")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 570")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 571")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 572")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Txt
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 36
        .Name = "+mn-lt"
    End With
    Range("A2").Select
End Sub


Open in new window

Does anyone have additional comments?  Working through on my own and making progress but having problem with this line
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 32).ParagraphFormat. _
        FirstLineIndent = 0

Is there any way I can just select al in the cell
Couple of questions.

How come you're using lots of text box/shapes?
Any reason why it can't just go in a cell?

A sample file would be useful.
ASKER CERTIFIED SOLUTION
Avatar of Norie
Norie

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Rob,

The reason I am doing it this way we are using an excel spreadsheet on a tab that has a template of a flatbed trailer.  On another tab we are copying and pasting the parts to but on the trailer from our erp system.  By putting them in shapes with the text of the part we can drag and place them where we want them positioned on the template as well as color code them to indicate what gets removed at each stop.

Norie,

Worked Perfectly !!!!!!
I assume each part will be a different size then.

I guess ideal scenario would be
1) a parts template sheet with dimensions and text for each stock item,
2) an input sheet to select Stock Item part number & order quantities,
3) a trailer template sheet.

Select part Numbers and quantities and then click a button to run a routine that creates the relevant number of shapes on the trailer sheet so that the user can re-arrange on that sheet for loading the trailer.
Rob,

That would be the ultimate solution.  For now I am creating the shapes on one tab with the macro and then will be manually selecting a column of shapes and copying manually to the Trailer template.  Having the macro automatically put them on the Trailer template would be icing on the cake. 
Or there is software out there that can do it for you.

https://www.easycargo3d.com/en/
We have looked at quite a few software packages but they are all based on cube dimensions.  We sell farm implements.  In a case of a gate there is open space.  So while you could stack 50 gates across there is still room to put something between so it does not properly account for area.