VBA Code
Adjustments Object
This object holds a collection of numbers used to move the adjustment handles of a Shape object.
Each shape object can have up to 8 different adjustments.
Each specific adjustment handle can have one or two adjustments associated with it depending on if it can be moved both horizontally and vertically.
Adjustment values are between 0 and 1 are are hence percentages.
'change the head of the arrow to start 30% of the way across
objshape.Adjustments(1) = 0.3 'left/right
'set the shaft to start 40% of the way down
objshape.Adjustments(2) = 0.4 'up/down
Shapes
Shapes.AddCanvas | Removed in 2007 |
Shapes.AddCallout | Creates a borderless line callout shape |
Shapes.AddConnector | Creates a chart. Charts > VBA > Creating |
Shapes.AddCurve | Creates a connector shape |
Shapes.AddFormControl | Creates a bezier curve |
Shapes.AddLabel | Creates a Form Control. Macros > Worksheet Controls |
Shapes.AddLine | Creates a line shape |
Shapes.AddOLEObject | Creates an ActiveX control Macros > Worksheet Controls |
Shapes.AddPicture | Creates a picture from an existing file |
Shapes.AddPolyline | Creates an open polyline or closed polyline shape |
Shapes.AddShape | Creates an Autoshape. |
Shapes.AddTextbox | Creates a textbox shape |
Shapes.AddTextEffect | Creates a WordArt |
objShape.Type = msoShapeType.msoTextBox
Shapes.AddTextBox(msoTextOrientationHorizontal, Selection.Left, Selection.Top, 20, 20)
Shapes.AddTextBox(msoTextOrientationHorizontal, Range("B2").Left, Range("B2").Top, 20, 20)
Dim objShape As Shape
objShape.Placement = xlPlacement.xlFreeFloating
objShape.PrintObject = False
ActiveShape.ScaleHeight 0.8, msoFalse, msoScaleFromBottomRight
Dim sngposition As Single
sngPosition = ActiveSheet.Shapes("Picture2").Top = sngPosition
Shapes - TextFrame
Shapes - TextBoxes
Identifying and changing
Sheets(1).Shapes("TextBox 2").TextFrame.Characters.Text = "some text"
objShape = objWsh.Shapes.Item("Name")
objTextFrame = objShape.TextFrame
A TextFrame property was added in Excel 2007 ??
objTextFrame = Characters.Text = "the text"
Is there an error if you assign a zero length text ???
With ActiveSheet.Shapes(1).TextFrame
.Characters.Text = "some text"
.Characters(1,4).Font.Bold = True
End With
Formatting
You can either specify the exact colour using the RGB function or you can use an index from the Colour Scheme
objShape.Fill.ForeColor.RGB = RGB(12, 12, 12)
objShape.Fill.BackColor.RGB = RGB(12, 12, 12)
objShape.Line.ForeColor.RGB = RGB(12, 12, 12)
objShape.Line.BackColor.RGB = RGB(12, 12, 12)
ojShape.Fill.ForeColor.SchemeColor = 60
The macro recorder will always record a mixture of both exact colours and colours from the Colour Scheme
objShape.Line.ForeColor.SchemeColor = 19
objShape.Line.BackColor.RGB = RGB(255, 255, 255)
You do not have to use the SchemeColor property to define you ForeColor but can use the RGB instead
objShape.Line.ForeColor.RGB = RGB(255, 255, 255)
Dim objShape As Excel.Shape
objShape.Line.ForeColor.RGB = Microsoft.VisualBasic.RGB(0, 0, 0)
objShape.Line.BackColor.RGB = Microsoft.VisualBasic.RGB(255, 255, 255)
objShape.Line.Visible = Office.MsoTriState.msoTrue
objShape.Line.Weight = 0.75
objShape.Line.DashStyle = Office.MsoLineDashStyle.msoLineSolid
objShape.Line.Style = Office.MsoLineStyle.msoLineSingle
objShape.Line.Transparency = 0.0#
objShape.Line.Pattern = Office.MsoPatternType.msoPattern25Percent
objShape.Line.BeginArrowheadLength = Office.MsoArrowheadLength.msoArrowheadLengthMedium
objShape.Line.BeginArrowheadStyle = Office.MsoArrowheadStyle.msoArrowheadDiamond
objShape.Line.BeginArrowheadWidth = Office.MsoArrowheadWidth.msoArrowheadWide
objShape.Line.EndArrowheadLength = Office.MsoArrowheadLength.msoArrowheadLengthMixed
objShape.Line.EndArrowheadStyle = Office.MsoArrowheadStyle.msoArrowheadDiamond
objShape.Line.EndArrowheadWidth = Office.MsoArrowheadWidth.msoArrowheadWidthMedium
objShape.Fill.BackColor.RGB = Microsoft.VisualBasic.RGB(255, 255, 255)
objShape.Fill.ForeColor.RGB = Microsoft.VisualBasic.RGB(255, 255, 255)
objShape.Fill.OneColorGradient(Office.MsoGradientStyle.msoGradientDiagonalDown, 2, 2)
objShape.Fill.TwoColorGradient(Office.MsoGradientStyle.msoGradientDiagonalDown, 3)
objShape.Fill.Transparency = 0
objShape.Fill.Visible = Office.MsoTriState.msoTrue
objShape.Fill.Patterned(Office.MsoPatternType.msoPattern10Percent)
Applying Solid Fill
oShape.Fill.Solid
oShape.Fill.ForeColor.RGB = RGB(5,5,5)
Applying Gradient Fill
oShape.Fill.ResetTextured msoTextureSand
Removing Fill
oShape.Fill.Visible = Office.msoTristate.msoFalse
Sub BET_DisplayColourScheme()
Dim inumber As Integer
For inumber = 1 To 80
Range("A" & inumber + 1).Value = inumber
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 47.25, inumber * 12.75, 93.75, 12.75).Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = inumber
Selection.ShapeRange.Fill.Transparency = 0#
Next inumber
End Sub
Creates a picture (on OLE Object) from an existing file
Shapes.AddPicture
Adds a picture to a worksheet.
Dim objWsh as Excel.Worksheet
dim objShape As Excel.Shape
Set objShape = objWsh.Shapes.AddPicture(FileName:="C:\temp\image.bmp, _
LinkToFile:=msoTriState.msoFalse, _
SaveWithDocument:=msoTriState.msoTrue, _
Left:=80, _
Top:=80, _
Width:=80, _
Height:=80)
objShape.LockAspectRatio = msotristate.msotrue
FileName - The full path of the picture or graphic to insert
LinkToFile - Indicates whether the picture is linked or not
SaveWithDocument - Indicates whether the picture is saved in the worksheet (must be true in VBA. If set to false you set a "the specified value is out of range" error)
Left - The position of the left edge relative to the active cell (in points)
Top - The position of the top edge relative to the active cell (in points)
Width - The width of the picture (in points)
Height - The height of the picture (in points)
Adding AutoShapes
ActiveSheet.Shapes.AddShape(Type:=msoAutoShapeType.msoShapeMoon, _
Left:=20, _
Top:=20, _
Width:=20, _
Height:=20).Select
Shapes.AddShape(msoAutoShapeType.
Removing all the AutoShapes
Dim shpShade as Shape
For Each shpShape in Sheets(1).Shapes
If Left(shpShape.Name,9) = "AutoShape" Then
shpShape.Delete
End If
Next shpShape
Shapes - ShapeRange
A shaperange can contain a single shape or all the shapes on a worksheet
You can create a shape range collection and add specific shapes to it
Use Selection.ShapeRange to return all the shapes in the current selection.
Dim objshaperange As Excel.ShapeRange
Set objshaperange = ActiveSheet.Shapes.Range(Array(1,2))
ActiveSheet.Shapes.Range(1)
ActiveSheet.Shapes.Range("Line 1")
ActiveSheet.Shapes.SelectAll
ActiveSheet.Shapes.Range("Line 1","WordArt 2")
ActiveSheet.Shapes.Item("Line 1")
Adjusting Shape Sizes
depends on the zoom % of the worksheet
0.6 at 80%
is not 0.6 at 100% ???
Diagrams (new to 2002)
Access to the (Insert > Diagrams) objects is now possible through VBA through various DiagramXxx objects.
Adding WordArt
ActiveSheet.Shapes.AddTextEffect(PresetTextEffect:=, _
Text:=, _
FontName:=, _
FontSize:=, _
FontBold:=, _
FontItalic:=, _
Left:=, _
Top:=).Select
PresetTextEffect -
Text -
FontName -
FontSize -
FontBold -
FontItalic -
Left -
Top -
Pictures.Insert (depreciated)
In Excel 2007 this method inserts the picture as an embedded object
In Excel 2010 and later this method inserts the picture as a link (be warned)
This is not displayed in the intellisense and is only available for backwards compatibility
Dim oWsh As Excel.Worksheet
Dim oPicture As Excel.Picture
Set oPicture = oWsh.Pictures.Insert(Filename:="C:\temp\picture.png")
oPicture.Width =
oPicture.Height =
oPicture.Left =
oPicture.Top =
oPicture.Placement = xlMoveAndSize
oPicture.PrintObject
© 2022 Better Solutions Limited. All Rights Reserved. © 2022 Better Solutions Limited TopPrevNext