ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 6655|回复: 8

[分享] 让shape旋转起来(shape对象特殊技巧)

[复制链接]

TA的精华主题

TA的得分主题

发表于 2011-12-11 19:10 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:Shape对象
本帖最后由 wlianke 于 2011-12-11 19:29 编辑

能不能让我们的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, 下载次数: 434)

该贴已经同步到 wlianke的微博

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-12-11 19:45 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
设置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

TA的精华主题

TA的得分主题

发表于 2011-12-11 19:29 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-12-11 20:10 | 显示全部楼层
提供一个可以返回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

TA的精华主题

TA的得分主题

发表于 2011-12-11 22:11 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2011-12-13 12:04 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-5-25 20:18 | 显示全部楼层
您好,请问msoShape....这个里面有没有 ×  这个图形啊,在帮助文档里头,就看到个最像的四角形,但不知道怎么旋转

TA的精华主题

TA的得分主题

发表于 2017-8-31 17:21 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-6-28 13:35 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 22:45 , Processed in 0.050072 second(s), 14 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表