VBA/Excel/Access/Word/Excel/Shape

Материал из VB Эксперт
Перейти к: навигация, поиск

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>