VBA/Excel/Access/Word/Excel/Shape — различия между версиями

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

Текущая версия на 12:47, 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