VBA/Excel/Access/Word/Excel/Shape
Версия от 16:33, 26 мая 2010; (обсуждение)
Содержание
Create a shape and set its color
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
Delete a shape
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
Get shape and output its z order
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
Looping through a Collection of Shapes
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
The OLEObjects Collection
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