Selects a shape inside sheet to change it, or if not found, it will create it then change it.
This can be enhanced by passing those changes as parameters in future.
DANGER! ..... in ActiveSheet only for now, more changes needed to have it in other sheets.
Another side product of my work.
Function Shape_Select_or_CreateThenSelect(ShapeName)
' creates shape in sheet, then select it
' DANGER! ..... in ActiveSheet only for now, more changes needed to have it in other sheets.
On Error Resume Next
ActiveSheet.Shapes(ShapeName).Select
If Err.Number < > 0 Then
Set someobj = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 40, 1000, 20, 20)
someobj.Select
With Selection.ShapeRange.TextFrame2.TextRange.Font
.NameComplexScript = "Times New Roman"
.NameFarEast = "Times New Roman"
.Name = "Times New Roman"
End With
Selection.ShapeRange.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
Selection.ShapeRange.TextFrame2.HorizontalOverflow = xlOartHorizontalOverflowClip
Selection.ShapeRange.TextFrame2.WordWrap = msoFalse 'msoAutoSizeShapeToFitText
Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 12
Selection.ShapeRange.Line.Visible = msoFalse
Selection.Name = ShapeName
End If
On Error GoTo 0
End Function
' creates shape in sheet, then select it
' DANGER! ..... in ActiveSheet only for now, more changes needed to have it in other sheets.
On Error Resume Next
ActiveSheet.Shapes(ShapeName).Select
If Err.Number < > 0 Then
Set someobj = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 40, 1000, 20, 20)
someobj.Select
With Selection.ShapeRange.TextFrame2.TextRange.Font
.NameComplexScript = "Times New Roman"
.NameFarEast = "Times New Roman"
.Name = "Times New Roman"
End With
Selection.ShapeRange.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
Selection.ShapeRange.TextFrame2.HorizontalOverflow = xlOartHorizontalOverflowClip
Selection.ShapeRange.TextFrame2.WordWrap = msoFalse 'msoAutoSizeShapeToFitText
Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 12
Selection.ShapeRange.Line.Visible = msoFalse
Selection.Name = ShapeName
End If
On Error GoTo 0
End Function
ShapeName
Views 121
Downloads 51
CodeID
DB ID