VBA/Excel/Access/Word/Excel/Shape
Содержание
Create a shape and set its color
<source lang="vb">
Sub SetShapeColor()
StarWidth = 25 StarHeight = 25 Set NewStar = ActiveSheet.Shapes.AddShape(msoShape4pointStar, LeftPos, TopPos, StarWidth, StarHeight) NewStar.Fill.ForeColor.SchemeColor = Int(Rnd() * 56) Application.Wait Now + TimeValue("00:00:01") DoEvents Application.Wait Now + TimeValue("00:00:02")
End Sub
</source>
Delete a shape
<source lang="vb">
Sub DeleteShape()
Set NewStar = ActiveSheet.Shapes.AddShape(msoShape4pointStar, LeftPos, TopPos, StarWidth, StarHeight) NewStar.Fill.ForeColor.SchemeColor = Int(Rnd() * 56) Application.Wait Now + TimeValue("00:00:01") DoEvents Application.Wait Now + TimeValue("00:00:02") Set myShapes = Worksheets(1).Shapes For Each myShape In myShapes myShape.Delete Application.Wait Now + TimeValue("00:00:01") Next
End Sub
</source>
Get shape and output its z order
<source lang="vb">
Sub Shape_Index_Name()
Dim myVar As Shapes Dim myShape As Shape Set myVar = Sheets(1).Shapes For Each myShape In myVar MsgBox "Index = " & myShape.ZOrderPosition & vbCrLf & "Name = " _ & myShape.Name Next
End Sub
</source>
Looping through a Collection of Shapes
<source lang="vb">
Sub LoopThruShapes()
Dim sh As Shape Dim I As Integer I = 1 For Each sh In ActiveSheet.Shapes If sh.Type = msoLine Then Cells(I, 1).value = sh.name I = I + 1 End If Next
End Sub
</source>
The OLEObjects Collection
<source lang="vb">
Public Sub AddCommandButton()
ActiveSheet.Shapes.AddOLEObject(ClassType:="Forms.rumandButton.1").name = "cmdTest" With ActiveSheet.OLEObjects("cmdTest") .Left = range("C1").Left .Top = range("C4").Top End With ActiveSheet.OLEObjects("cmdTest").Object.Caption = "Click Me"
End Sub
</source>