让shape旋转起来（shape对象特殊技巧）

wlianke

能不能让我们的shape对象如动画般旋转起来呢？该程序可以做到，非常有趣哦！！
代码如下：
Public Sub shapespin()
Dim myshape As Shape
Dim ws As Worksheet
Dim i As Long
Dim j As Long
Set ws = Worksheets(1)
With ws
    For Each myshape In .Shapes
        myshape.Delete
    Next
    Set myshape = .Shapes.AddShape(Type:=msoShape5pointStar, Left:=120, Top:=80, Width:=80, Height:=80)
End With
With myshape
    For i = 1 To 3000 Step 5
        .Top = Sin(i * (3.1416 / 180)) * 100 + 100
        .Left = Cos(i * (3.1416 / 180)) * 100 + 100
        .Fill.ForeColor.RGB = i * 100
        For j = 1 To 10
            .IncrementRotation -2
            DoEvents
        Next j
    Next i
End With
End Sub

旋转的shape.rar (11.16 KB, 下载次数: 436)

2011-12-11 19:28 上传

点击文件名下载附件

该贴已经同步到 wlianke的微博

wlianke

设置shape对象大小和位置是否随单元格而改变：
'利用placement属性，可能设置对象与所在的单元格之间的附属关系，取shape对象大小和位置是否随单元格而改变。当placement属性为xlfreefloating时，shape对象可自由浮动当placement属性为xlmoveandsize时，shape对象大小和位置随单元格而改变；当placement属性为xlmove时，shape对象大小固定，位置随单元格而改变。你可以改变
placement的不同属性进行测试哦！
Public Sub shape变()
    Dim myshape As shape, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    Set myshape = ws.Shapes(1)
    With myshape
        .Placement = xlMoveAndSize
    End With
    Set myshape = Nothing
    Set ws = Nothing
End Sub

吴民光

呵呵，这个好玩.

wlianke

提供一个可以返回shape对象类型名称的函数，处理shape对象非常有用的哦！
Public Function mytypename(myshape As shape) As String
    With myshape
        Select Case .Type
            Case msoShapeTypeMixed
                mytypename = "混合型图形"
            Case msoAutoShape
                mytypename = "自选图形"
            Case msoCallout
                mytypename = "图表"
            Case msoComment
                mytypename = "批注"
            Case msoFreeform
                mytypename = "任意多边形"
            Case msoGroup
                mytypename = "图形组合"
            Case msoFormControl
                mytypename = "窗体控件"
            Case msoLine
                mytypename = "线条"
            Case msoLinkedOLEObject
                mytypename = "链接式或内嵌ole对象"
            Case msoLinkedPicture
                 mytypename = "剪贴画或图片"
            Case msoOLEControlObject
                mytypename = "Activex 控件"
            Case msoPicture
                mytypename = "图片"
            Case msoTextEffect
                mytypename = "艺术字"
            Case msoTextBox
                mytypename = "文本框"
            Case msoDiagram
                mytypename = "组织结构图或其他图示"
            Case Else
                mytypename = "其他类型的图形"
        End Select
    End With
End Function

wpxxsyzx

谢谢分享，做的不错

蓝天云朵

谢谢分享，请多发表作品。

品瑶

您好，请问msoShape....这个里面有没有 ×  这个图形啊，在帮助文档里头，就看到个最像的四角形，但不知道怎么旋转

02761752696

谢谢     分享

1059526347

挺好玩的呀，谢谢分享