kristiknyc
10-24-2022, 06:58 AM
Hi everyone,
I'm working on a "stamp" in excel that I'd like to have a combination of consistent text (Sketch Updated: ) and today's date (per #1 below). I've written the macro for the text and formatting for this text box with hard keyed text only, but am having trouble incorporating a way to paste today's date (per #2 below).
30273
Here's the code I have so far for option 2 above:
Sub SketchUpdatedDate()
'
' SketchUpdatedDate Macro
'
'
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 51.75, 67.5, 228, _
33).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
"Sketch Updated: TODAY DATE"
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 26).ParagraphFormat. _
FirstLineIndent = 0
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 26).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
Selection.ShapeRange.ScaleWidth 0.7368421053, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.5909090909, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Line.Visible = msoFalse
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 26).Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With
Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
Range("D10").Select
End Sub
I tried linking the box to a cell within the sheet with the date, per the below, but this prevented me from inserting any other hard keyed text:
30274
Any help is much appreciated!!
I'm working on a "stamp" in excel that I'd like to have a combination of consistent text (Sketch Updated: ) and today's date (per #1 below). I've written the macro for the text and formatting for this text box with hard keyed text only, but am having trouble incorporating a way to paste today's date (per #2 below).
30273
Here's the code I have so far for option 2 above:
Sub SketchUpdatedDate()
'
' SketchUpdatedDate Macro
'
'
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 51.75, 67.5, 228, _
33).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
"Sketch Updated: TODAY DATE"
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 26).ParagraphFormat. _
FirstLineIndent = 0
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 26).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
Selection.ShapeRange.ScaleWidth 0.7368421053, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.5909090909, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Line.Visible = msoFalse
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 26).Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With
Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
Range("D10").Select
End Sub
I tried linking the box to a cell within the sheet with the date, per the below, but this prevented me from inserting any other hard keyed text:
30274
Any help is much appreciated!!