Clear contents of Shape (with text in it), re-add fixed text + unique number

[justanotheruser]

Hi guys,

I've got a rounded rectangle shape that I have "added text" to, and it is formatted in a particular way. The contents of the shape will usually be something like this:

Ref: Online Order 1234567890123456789 - Extra comments go here.

I was wondering if it is possible to have a macro that can clear the contents of the text box, and then re-add the "Ref: Online Order" bit, and then add the order number from cell O9, whilst keeping the original formatting.

I tried to record a macro to do it, but the order number is fixed, not the value of cell O9.

Sub Macro1()
'
' Macro1 Macro
'

'
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
        "Ref: Online Order  "
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 19).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 19).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "Arial"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 16
        .Name = "Arial"
    End With
    Range("O9").Select
    Selection.Copy
    ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
        "Ref: Online Order 1234567890123456789   "
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 40).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 40).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "Arial"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 16
        .Name = "Arial"
    End With
End Sub

The shape is called "TextBox 1" on the sheet.

The reason I'm asking for this is that there is a template where the user can just copy and paste all details from an order confirmation email and everything will be automatically put in the right place (in Proper Case too) - the only thing which I can't figure out is the order number!

Thanks in advance for your help.

 

[justanotheruser]

Any suggestions, perhaps it would be possible to set the .Value of the cell to blank/nothing and then add the text, is this possible with VBA? Thanks! :D

 

[Gary McMaster]

I would just concatenate the literal text and the contents of cell "O9" and set the format each time the text is changed. Sometimes the macro recorder gives you more than you need. This may be one of those cases. Seems like a lot of code for what you're asking.

Here's a sample. Hope it helps.

Gary

Public Sub Test()

Dim oShape As Shape

Set oShape = ActiveSheet.Shapes("TextBox 1") 'Change name to suit

'Concatenate literal text & cell "O9" & put in text box
oShape.TextFrame.Characters.Text = "Ref: Online Order " & ActiveSheet.Range("O9").Text

'Change 1st 17 characters to bold, italic, green, size 16
oShape.TextFrame.Characters(1, 17).Font.Bold = True
oShape.TextFrame.Characters(1, 17).Font.Italic = True
oShape.TextFrame.Characters(1, 17).Font.ColorIndex = 4
oShape.TextFrame.Characters(1, 17).Font.Size = 16

'Change 18th character to end of string to red normal font style
oShape.TextFrame.Characters(18).Font.Bold = False
oShape.TextFrame.Characters(18).Font.Italic = False
oShape.TextFrame.Characters(18).Font.ColorIndex = 3

End Sub

 

[justanotheruser]

I would just concatenate the literal text and the contents of cell "O9" and set the format each time the text is changed. Sometimes the macro recorder gives you more than you need. This may be one of those cases. Seems like a lot of code for what you're asking.

Here's a sample. Hope it helps.

Gary

Public Sub Test()

Dim oShape As Shape

Set oShape = ActiveSheet.Shapes("TextBox 1") 'Change name to suit

'Concatenate literal text & cell "O9" & put in text box
oShape.TextFrame.Characters.Text = "Ref: Online Order " & ActiveSheet.Range("O9").Text

'Change 1st 17 characters to bold, italic, green, size 16
oShape.TextFrame.Characters(1, 17).Font.Bold = True
oShape.TextFrame.Characters(1, 17).Font.Italic = True
oShape.TextFrame.Characters(1, 17).Font.ColorIndex = 4
oShape.TextFrame.Characters(1, 17).Font.Size = 16

'Change 18th character to end of string to red normal font style
oShape.TextFrame.Characters(18).Font.Bold = False
oShape.TextFrame.Characters(18).Font.Italic = False
oShape.TextFrame.Characters(18).Font.ColorIndex = 3

End Sub

Hi Gary, thanks for your response.

That's really strange that the macro recorder is giving the different colours/formatting, I would like all of the text to be formatted as only Bold, Red and Arial size 16 - not green. I'm wondering where on earth that appeared from! What do I need to change so that it applies to the whole cell, instead of a certain number of characters?

Thanks in advance for your help!

 

[justanotheruser]

Thanks for your help, I have managed to fix the code:

Public Sub OnlineOrder()

Dim oShape As Shape

Set oShape = ActiveSheet.Shapes("TextBox 1") 'Change name to suit

'Concatenate literal text & cell "O9" & put in text box
oShape.TextFrame.Characters.Text = "Ref: Online Order " & ActiveSheet.Range("O9").Text

'Change Text to bold, red, size 16
oShape.TextFrame.Characters.Font.Bold = True
oShape.TextFrame.Characters.Font.Italic = False
oShape.TextFrame.Characters.Font.ColorIndex = 3
oShape.TextFrame.Characters.Font.Size = 16

End Sub