ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[原创] 创意代码分享——PPT图表动画

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2012-2-17 11:09 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:PPT协同
十年前的今天,我在ExcelHome.Net注册,自此,开始了狂热的Excel学习;之后不久,又发现PowerPoint也是一个迷人的世界,于是同时也开始对PowerPoint的学习。相对于Excel来讲,老版本的PowerPoint能做的真是少之又少,但是随着版本的升级,PowerPoint的内容也迅速地丰富起来,特别是PowerPoint里面的动画,简直让人着迷!当然,PowerPoint里面还有很多很多不那么理想的东西,特别是,很多东西无法通过手动实现,又或者说动画就像以前的胶片电影一样,一个小动作是成百上千张照片逐帧出现的——一般人哪有这个精力、能力制作精美的动画啊?于是想到编程,一个复杂的动画,手动制作或许得几天时间;如果找到其数学模型,那么用编程来实现只是几秒钟的事情!PowerPoint对图表的动画支持远远不够,我们可以利用图形来制作“假”图表,这样的图表可以做得非常漂亮,动画实现随心所欲,我们的演讲也会因此而非常有逻辑,非常吸引观众!  这是我去年开发的代码,放在这里,有点基础的人一看就明白。所以,我要说的是,分享代码不是什么,关键是创意! 以此纪念我步入MS Office江湖的十周年!
[code=vb]
Option Explicit Dim sldTemp As Slide
Dim shpPointStyle As Shape
Dim shpTemp As Shape
Private Sub cbbPointStyle_Change()
    On Error Resume Next
    With Me
        If .mpReference.Value = 0 Then
            .lstAllShapes.Clear
            .lstRefShapes.Clear
            With .lstAllShapes
                For Each shpTemp In sldTemp.Shapes
                    If shpTemp.Name <> Me.cbbPointStyle.Text Then
                        .AddItem shpTemp.Name
                    End If
                Next
            End With
        Else
            .cbbFreeform.Clear
            With .cbbFreeform
                For Each shpTemp In sldTemp.Shapes
                    If shpTemp.Name <> Me.cbbPointStyle.Text Then
                        .AddItem shpTemp.Name
                    End If
                Next
                .ListIndex = 0
            End With
        End If
    End With
End Sub
Private Sub cbbSlide_Change()
    On Error GoTo errHandler
    Set sldTemp = ActivePresentation.Slides(Me.cbbSlide.ListIndex + 1)
    sldTemp.Select
    With Me.cbbPointStyle
        .Clear
        For Each shpTemp In sldTemp.Shapes
            .AddItem shpTemp.Name
        Next
        .ListIndex = 0
    End With
    Exit Sub
errHandler:
    If Err.Number = 380 Then
        MsgBox "所选幻灯片上面没有图形。请另选其它幻灯片。", vbCritical, "错误"
    Else
    End If
End Sub
Private Sub cbKeepLine_Click()
    With Me
        .cmdLineColor.Enabled = .cbKeepLine.Value
        .txtR.Enabled = .cbKeepLine.Value
        .txtG.Enabled = .cbKeepLine.Value
        .txtB.Enabled = .cbKeepLine.Value
        .txtLineWeight.Enabled = .cbKeepLine.Value
    End With
End Sub
[/code]

为了方便网友,我将窗体界面和代码直接打包上传。
frmChartAnimPoints.zip (3.52 KB, 下载次数: 2651)


该贴已经同步到 hxhgxy的微博

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-2-17 11:11 | 显示全部楼层
重新贴代码:
[code=vb]Option Explicit

Dim sldTemp As Slide
Dim shpPointStyle As Shape
Dim shpTemp As Shape

Private Sub cbbPointStyle_Change()
    On Error Resume Next
    With Me
        If .mpReference.Value = 0 Then
            .lstAllShapes.Clear
            .lstRefShapes.Clear
            With .lstAllShapes
                For Each shpTemp In sldTemp.Shapes
                    If shpTemp.Name <> Me.cbbPointStyle.Text Then
                        .AddItem shpTemp.Name
                    End If
                Next
            End With
        Else
            .cbbFreeform.Clear
            With .cbbFreeform
                For Each shpTemp In sldTemp.Shapes
                    If shpTemp.Name <> Me.cbbPointStyle.Text Then
                        .AddItem shpTemp.Name
                    End If
                Next
                .ListIndex = 0
            End With
        End If
    End With
End Sub

Private Sub cbbSlide_Change()
    On Error GoTo errHandler
    Set sldTemp = ActivePresentation.Slides(Me.cbbSlide.ListIndex + 1)
    sldTemp.Select
    With Me.cbbPointStyle
        .Clear
        For Each shpTemp In sldTemp.Shapes
            .AddItem shpTemp.Name
        Next
        .ListIndex = 0
    End With
    Exit Sub
errHandler:
    If Err.Number = 380 Then
        MsgBox "所选幻灯片上面没有图形。请另选其它幻灯片。", vbCritical, "错误"
    Else
   
    End If
End Sub

Private Sub cbKeepLine_Click()
    With Me
        .cmdLineColor.Enabled = .cbKeepLine.Value
        .txtR.Enabled = .cbKeepLine.Value
        .txtG.Enabled = .cbKeepLine.Value
        .txtB.Enabled = .cbKeepLine.Value
        .txtLineWeight.Enabled = .cbKeepLine.Value
    End With
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub[/code]

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-2-17 11:12 | 显示全部楼层
[code=vb]Private Sub cmdOK_Click()
    '计数器
    Dim i As Integer
    Dim j As Integer
    Dim iPoints As Integer
    Dim iNodesCount As Integer
   
    Dim shpPointTemp As Shape
   
    Dim bfTemp As FreeformBuilder
    Dim shpFreeform As Shape
    Dim bBessel As Boolean
   
    Dim effTemp As Effect
    Dim bhvTemp As AnimationBehavior

    Dim sinX0 As Single
    Dim sinY0 As Single
    Dim sinX1 As Single
    Dim sinY1 As Single
    Dim sinX2 As Single
    Dim sinY2 As Single
    Dim sinX3 As Single
    Dim sinY3 As Single
   
    Dim sinSldWidth As Single
    Dim sinSldHeight As Single
   
    Dim strVMLPath As String
   
    Set sldTemp = ActivePresentation.Slides(Me.cbbSlide.ListIndex + 1)
    With sldTemp
        On Error GoTo errHandler
        sinSldWidth = .Master.Width
        sinSldHeight = .Master.Height
        
        Set shpPointStyle = .Shapes(Me.cbbPointStyle.Text)
        
        If Me.mpReference.Value = 0 Then
'基于用户指定的数据点设置图表动画
            bBessel = Me.optBessel.Value
            iPoints = Me.lstRefShapes.ListCount
            Set shpTemp = .Shapes(Me.lstRefShapes.List(0))
            '根据用户提供的数据点,绘制自由曲线或者折线
            Set bfTemp = .Shapes.BuildFreeform(msoEditingAuto, _
                                    shpTemp.Left + shpTemp.Width / 2, _
                                    shpTemp.Top + shpTemp.Height / 2)
            For i = 1 To iPoints - 1
                Set shpTemp = .Shapes(Me.lstRefShapes.List(i))
                If Me.optBessel Then
                    bfTemp.AddNodes msoSegmentCurve, msoEditingAuto, _
                            shpTemp.Left + shpTemp.Width / 2, _
                            shpTemp.Top + shpTemp.Height / 2
                Else
                    bfTemp.AddNodes msoSegmentLine, msoEditingAuto, _
                            shpTemp.Left + shpTemp.Width / 2, _
                            shpTemp.Top + shpTemp.Height / 2
                End If
            Next i
            Set shpFreeform = bfTemp.ConvertToShape
            With shpFreeform.Line
                .Visible = msoTrue
                .Weight = Me.txtLineWeight
                .ForeColor.RGB = RGB(Me.txtR.Text, Me.txtG.Text, Me.txtB.Text)
            End With
            '将数据标志移动到系列线上面
            shpPointStyle.ZOrder msoBringToFront
        Else
'基于用户指定的自由曲线设置图表动画
            Set shpFreeform = .Shapes(Me.cbbFreeform.Text)
            With shpFreeform
                '指定图形是否是自由曲线,如果节点数为0则否,报错
                If .Nodes(1).SegmentType = msoSegmentCurve Then
                    bBessel = True
                Else
                    bBessel = False
                End If
            End With
        End If
        iNodesCount = shpFreeform.Nodes.Count
        
        If bBessel Then
        '贝塞尔曲线轨迹动画
            strVMLPath = "M 0 0 C "
            If Me.optOnePoint.Value Then
            '如果只有一个数据标志
                With shpFreeform
                    shpPointStyle.Left = .Nodes(1).Points(1, 1) - shpPointStyle.Width / 2
                    shpPointStyle.Top = .Nodes(1).Points(1, 2) - shpPointStyle.Height / 2
                    sinX0 = .Nodes(1).Points(1, 1)
                    sinY0 = .Nodes(1).Points(1, 2)
                    For i = 1 To VBA.Int(iNodesCount / 3)
                        sinX1 = .Nodes(3 * (i - 1) + 2).Points(1, 1)
                        sinY1 = .Nodes(3 * (i - 1) + 2).Points(1, 2)
                        sinX2 = .Nodes(3 * (i - 1) + 3).Points(1, 1)
                        sinY2 = .Nodes(3 * (i - 1) + 3).Points(1, 2)
                        sinX3 = .Nodes(3 * (i - 1) + 4).Points(1, 1)
                        sinY3 = .Nodes(3 * (i - 1) + 4).Points(1, 2)
                        strVMLPath = strVMLPath & (sinX1 - sinX0) / sinSldWidth & " " & (sinY1 - sinY0) / sinSldHeight & " " _
                                                    & (sinX2 - sinX0) / sinSldWidth & " " & (sinY2 - sinY0) / sinSldHeight & " " _
                                                    & (sinX3 - sinX0) / sinSldWidth & " " & (sinY3 - sinY0) / sinSldHeight & IIf(i < VBA.Int(iNodesCount / 3), " C ", " E")
                    Next i
                End With
                '设置动画
                Set effTemp = .TimeLine.MainSequence.AddEffect( _
                                                        Shape:=shpPointStyle, _
                                                        effectid:=msoAnimEffectCustom, _
                                                        trigger:=msoAnimTriggerOnPageClick)
                With effTemp
                    Set bhvTemp = .Behaviors.Add(msoAnimTypeProperty)
                    With bhvTemp
                        With .Timing
                            .Duration = 1
                            .TriggerDelayTime = 0
                        End With
                        With .PropertyEffect
                            .Property = msoAnimOpacity
                            .From = 0
                            .To = 1
                        End With
                    End With
                    Set bhvTemp = .Behaviors.Add(msoAnimTypeMotion)
                    With bhvTemp
                        With .Timing
                            .Duration = 4
                            .TriggerDelayTime = 1
                        End With
                        With .MotionEffect
                            .Path = strVMLPath
                        End With
                    End With
                End With
            Else
            '保留所有数据标志
                For j = 1 To VBA.Int(iNodesCount / 3) + 1
                    strVMLPath = "M 0 0 C "
                    If j = 1 Then
                        '复制数据标志,并将其移动到相应位置
                        Set shpPointTemp = shpPointStyle.Duplicate.Item(1)
                        With shpPointTemp
                            .Name = "shpPoint" & j
                            .Left = shpFreeform.Nodes(1).Points(1, 1) - .Width / 2
                            .Top = shpFreeform.Nodes(1).Points(1, 2) - .Width / 2
                        End With
                        '第一个数据点的动画只是淡入
                        Set effTemp = .TimeLine.MainSequence.AddEffect( _
                                            Shape:=shpPointTemp, _
                                            effectid:=msoAnimEffectCustom, _
                                            trigger:=msoAnimTriggerOnPageClick)
                        With effTemp
                            Set bhvTemp = .Behaviors.Add(msoAnimTypeProperty)
                            With bhvTemp
                                With .Timing
                                    .Duration = 1
                                End With
                                With .PropertyEffect
                                    .Property = msoAnimOpacity
                                    .From = 0
                                    .To = 1
                                End With
                            End With
                        End With
                    Else
                        '复制数据标志,并将其移动到相应位置
                        Set shpPointTemp = shpPointStyle.Duplicate.Item(1)
                        With shpPointTemp
                            .Name = "shpPoint" & j
                            .Left = shpFreeform.Nodes(3 * (j - 2) + 1).Points(1, 1) - .Width / 2
                            .Top = shpFreeform.Nodes(3 * (j - 2) + 1).Points(1, 2) - .Width / 2
                        End With
                        '第二个以及后面的数据点的动画
                        '从前面数据点的位置淡入,然后移动到目标位置
                        Set effTemp = .TimeLine.MainSequence.AddEffect( _
                                            Shape:=shpPointTemp, _
                                            effectid:=msoAnimEffectCustom, _
                                            trigger:=msoAnimTriggerAfterPrevious)
                        With effTemp
                            Set bhvTemp = .Behaviors.Add(msoAnimTypeProperty)
                            With bhvTemp
                                With .Timing
                                    .Duration = 0.1
                                End With
                                With .PropertyEffect
                                    .Property = msoAnimOpacity
                                    .From = 0
                                    .To = 1
                                End With
                            End With
                            With shpFreeform
                                sinX0 = .Nodes(3 * (j - 2) + 1).Points(1, 1)
                                sinY0 = .Nodes(3 * (j - 2) + 1).Points(1, 2)
                                sinX1 = .Nodes(3 * (j - 2) + 2).Points(1, 1)
                                sinY1 = .Nodes(3 * (j - 2) + 2).Points(1, 2)
                                sinX2 = .Nodes(3 * (j - 2) + 3).Points(1, 1)
                                sinY2 = .Nodes(3 * (j - 2) + 3).Points(1, 2)
                                sinX3 = .Nodes(3 * (j - 2) + 4).Points(1, 1)
                                sinY3 = .Nodes(3 * (j - 2) + 4).Points(1, 2)
                            End With
                            strVMLPath = strVMLPath & (sinX1 - sinX0) / sinSldWidth & " " & (sinY1 - sinY0) / sinSldHeight & " " _
                                                        & (sinX2 - sinX0) / sinSldWidth & " " & (sinY2 - sinY0) / sinSldHeight & " " _
                                                        & (sinX3 - sinX0) / sinSldWidth & " " & (sinY3 - sinY0) / sinSldHeight & " E"
'                            Debug.Print j & ": " & strVMLPath
                            Set bhvTemp = .Behaviors.Add(msoAnimTypeMotion)
                            With bhvTemp
                                With .Timing
                                    .Duration = 0.9
                                    .TriggerDelayTime = 0.1
                                End With
                                With .MotionEffect
                                    .Path = strVMLPath
                                End With
                            End With
                        End With
                    End If
                Next j
            End If
        Else[/code]

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-2-17 11:16 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
  1.         '折线轨迹动画
  2.             strVMLPath = "M 0 0 L "
  3.             If Me.optOnePoint.Value Then
  4.             '如果只有一个数据标志
  5.                 With shpFreeform
  6.                     shpPointStyle.Left = .Nodes(1).Points(1, 1) - shpPointStyle.Width / 2
  7.                     shpPointStyle.Top = .Nodes(1).Points(1, 2) - shpPointStyle.Height / 2
  8.                     sinX0 = .Nodes(1).Points(1, 1)
  9.                     sinY0 = .Nodes(1).Points(1, 2)
  10.                     For i = 2 To iNodesCount
  11.                         sinX1 = .Nodes(i).Points(1, 1)
  12.                         sinY1 = .Nodes(i).Points(1, 2)
  13.                         strVMLPath = strVMLPath & (sinX1 - sinX0) / sinSldWidth & " " & (sinY1 - sinY0) / sinSldHeight & IIf(i < iNodesCount, " L ", " E")
  14.                     Next i
  15.                 End With
  16.                 '设置动画
  17.                 Set effTemp = .TimeLine.MainSequence.AddEffect( _
  18.                                                         Shape:=shpPointStyle, _
  19.                                                         effectid:=msoAnimEffectCustom, _
  20.                                                         trigger:=msoAnimTriggerOnPageClick)
  21.                 With effTemp
  22.                     Set bhvTemp = .Behaviors.Add(msoAnimTypeProperty)
  23.                     With bhvTemp
  24.                         With .Timing
  25.                             .Duration = 1
  26.                             .TriggerDelayTime = 0
  27.                         End With
  28.                         With .PropertyEffect
  29.                             .Property = msoAnimOpacity
  30.                             .From = 0
  31.                             .To = 1
  32.                         End With
  33.                     End With
  34.                     Set bhvTemp = .Behaviors.Add(msoAnimTypeMotion)
  35.                     With bhvTemp
  36.                         With .Timing
  37.                             .Duration = 4
  38.                             .TriggerDelayTime = 1
  39.                         End With
  40.                         With .MotionEffect
  41.                             .Path = strVMLPath
  42.                         End With
  43.                     End With
  44.                 End With
  45.             Else
  46.             '保留所有数据标志
  47.                 For j = 1 To iNodesCount
  48.                     strVMLPath = "M 0 0 L "
  49.                     If j = 1 Then
  50.                         '复制数据标志,并将其移动到相应位置
  51.                         Set shpPointTemp = shpPointStyle.Duplicate.Item(1)
  52.                         With shpPointTemp
  53.                             .Name = "shpPoint" & j
  54.                             .Left = shpFreeform.Nodes(1).Points(1, 1) - .Width / 2
  55.                             .Top = shpFreeform.Nodes(1).Points(1, 2) - .Width / 2
  56.                         End With
  57.                         '第一个数据点的动画只是淡入
  58.                         Set effTemp = .TimeLine.MainSequence.AddEffect( _
  59.                                             Shape:=shpPointTemp, _
  60.                                             effectid:=msoAnimEffectCustom, _
  61.                                             trigger:=msoAnimTriggerOnPageClick)
  62.                         With effTemp
  63.                             Set bhvTemp = .Behaviors.Add(msoAnimTypeProperty)
  64.                             With bhvTemp
  65.                                 With .Timing
  66.                                     .Duration = 1
  67.                                 End With
  68.                                 With .PropertyEffect
  69.                                     .Property = msoAnimOpacity
  70.                                     .From = 0
  71.                                     .To = 1
  72.                                 End With
  73.                             End With
  74.                         End With
  75.                     Else
  76.                         '复制数据标志,并将其移动到相应位置
  77.                         Set shpPointTemp = shpPointStyle.Duplicate.Item(1)
  78.                         With shpPointTemp
  79.                             .Name = "shpPoint" & j
  80.                             .Select
  81.                             .Left = shpFreeform.Nodes(j - 1).Points(1, 1) - .Width / 2
  82.                             .Top = shpFreeform.Nodes(j - 1).Points(1, 2) - .Width / 2
  83.                         End With
  84.                         '第二个以及后面的数据点的动画
  85.                         '从前面数据点的位置淡入,然后移动到目标位置
  86.                         Set effTemp = .TimeLine.MainSequence.AddEffect( _
  87.                                             Shape:=shpPointTemp, _
  88.                                             effectid:=msoAnimEffectCustom, _
  89.                                             trigger:=msoAnimTriggerAfterPrevious)
  90.                         With effTemp
  91.                             Set bhvTemp = .Behaviors.Add(msoAnimTypeProperty)
  92.                             With bhvTemp
  93.                                 With .Timing
  94.                                     .Duration = 0.1
  95.                                 End With
  96.                                 With .PropertyEffect
  97.                                     .Property = msoAnimOpacity
  98.                                     .From = 0
  99.                                     .To = 1
  100.                                 End With
  101.                             End With
  102.                             With shpFreeform
  103.                                 sinX0 = .Nodes(j - 1).Points(1, 1)
  104.                                 sinY0 = .Nodes(j - 1).Points(1, 2)
  105.                                 sinX1 = .Nodes(j).Points(1, 1)
  106.                                 sinY1 = .Nodes(j).Points(1, 2)
  107.                             End With
  108.                             strVMLPath = strVMLPath & (sinX1 - sinX0) / sinSldWidth & " " & (sinY1 - sinY0) / sinSldHeight & " E"
  109. '                            Debug.Print j & ": " & strVMLPath
  110.                             Set bhvTemp = .Behaviors.Add(msoAnimTypeMotion)
  111.                             With bhvTemp
  112.                                 With .Timing
  113.                                     .Duration = 0.9
  114.                                     .TriggerDelayTime = 0.1
  115.                                 End With
  116.                                 With .MotionEffect
  117.                                     .Path = strVMLPath
  118.                                 End With
  119.                             End With
  120.                         End With
  121.                     End If
  122.                 Next j
  123.             End If
  124.         End If
  125.         If Me.mpReference.Value = 0 Then
  126.             '删除或者隐藏参考点
  127.             If MsgBox("删除或者隐藏用户指定的数据标志和数据标志样式?" & vbNewLine & vbNewLine & _
  128.                                 "点击Yes删除" & vbNewLine & "点击No隐藏", vbYesNo + vbDefaultButton1, "") = vbYes Then
  129.                 If Me.optAllPoints.Value Then shpPointStyle.Delete
  130.                 For i = 1 To Me.lstRefShapes.ListCount
  131.                     .Shapes(Me.lstRefShapes.List(i - 1)).Delete
  132.                 Next
  133.             Else
  134.                 If Me.optAllPoints.Value Then shpPointStyle.Visible = msoFalse
  135.                 For i = 1 To Me.lstRefShapes.ListCount
  136.                     .Shapes(Me.lstRefShapes.List(i - 1)).Visible = msoFalse
  137.                 Next
  138.             End If
  139.         Else
  140.             If Me.optAllPoints.Value Then
  141.                 If MsgBox("删除或者隐藏用户指定的数据标志样式?" & vbNewLine & vbNewLine & _
  142.                                     "点击Yes删除" & vbNewLine & "点击No隐藏", vbYesNo + vbDefaultButton1, "") = vbYes Then
  143.                     shpPointStyle.Delete
  144.                 Else
  145.                     shpPointStyle.Visible = msoFalse
  146.                 End If
  147.             End If
  148.         End If
  149.         If Me.cbKeepLine.Value = False Then
  150.             shpFreeform.Visible = msoFalse
  151.         End If
  152.     End With
  153.     Unload Me
  154.     Exit Sub
  155.    
  156. errHandler:
  157.     If Err.Number = -2147024809 Then
  158.         MsgBox "用户指定的参考折线不是自由折线,没有节点。请指定合法自由曲线。", vbCritical, "参考折线错误"
  159.     Else
  160.    
  161.     End If
  162.     Unload Me
  163. End Sub

  164. Private Sub lstAllShapes_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  165.     With Me.lstRefShapes
  166.         .AddItem Me.lstAllShapes.Text
  167.     End With
  168. End Sub

  169. Private Sub lstRefShapes_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  170.     With Me.lstRefShapes
  171.         .RemoveItem .ListIndex
  172.     End With
  173. End Sub

  174. Private Sub mpReference_Change()
  175.     With Me
  176.         If .mpReference.Value = 0 Then
  177.             .lstAllShapes.Clear
  178.             .lstRefShapes.Clear
  179.             With .lstAllShapes
  180.                 For Each shpTemp In sldTemp.Shapes
  181.                     If shpTemp.Name <> Me.cbbPointStyle.Text Then
  182.                         .AddItem shpTemp.Name
  183.                     End If
  184.                 Next
  185.             End With
  186.         Else
  187.             .cbbFreeform.Clear
  188.             With .cbbFreeform
  189.                 For Each shpTemp In sldTemp.Shapes
  190.                     If shpTemp.Name <> Me.cbbPointStyle.Text Then
  191.                         .AddItem shpTemp.Name
  192.                     End If
  193.                 Next
  194.                 .ListIndex = 0
  195.             End With
  196.         End If
  197.     End With
  198. End Sub

  199. Private Sub optAllPoints_Click()
  200.     If Me.optAllPoints Then
  201.         Me.cbKeepLine.Enabled = True
  202.     End If
  203. End Sub

  204. Private Sub optOnePoint_Click()
  205.     If Me.optOnePoint.Value Then
  206.         Me.cbKeepLine.Value = False
  207.         Me.cbKeepLine.Enabled = False
  208.     Else
  209.         Me.cbKeepLine.Enabled = True
  210.     End If
  211. End Sub

  212. Private Sub txtB_Change()
  213.     With Me
  214.         If VBA.IsNumeric(.txtB.Text) Then
  215.             If .txtB.Value > 255 Then
  216.                 .txtB.Text = 255
  217.             ElseIf .txtB.Value < 0 Then
  218.                 .txtB.Text = 0
  219.             End If
  220.         Else
  221.             .txtB.Text = 0
  222.         End If
  223.         .cmdLineColor.BackColor = RGB(.txtR.Text, .txtG.Text, .txtB.Text)
  224.     End With
  225. End Sub

  226. Private Sub txtG_Change()
  227.     With Me
  228.         If VBA.IsNumeric(.txtG.Text) Then
  229.             If .txtG.Value > 255 Then
  230.                 .txtG.Text = 255
  231.             ElseIf .txtG.Value < 0 Then
  232.                 .txtG.Text = 0
  233.             End If
  234.         Else
  235.             .txtG.Text = 0
  236.         End If
  237.         .cmdLineColor.BackColor = RGB(.txtR.Text, .txtG.Text, .txtB.Text)
  238.     End With
  239. End Sub

  240. Private Sub txtR_Change()
  241.     With Me
  242.         If VBA.IsNumeric(.txtR.Text) Then
  243.             If .txtR.Value > 255 Then
  244.                 .txtR.Text = 255
  245.             ElseIf .txtR.Value < 0 Then
  246.                 .txtR.Text = 0
  247.             End If
  248.         Else
  249.             .txtR.Text = 0
  250.         End If
  251.         .cmdLineColor.BackColor = RGB(.txtR.Text, .txtG.Text, .txtB.Text)
  252.     End With
  253. End Sub

  254. Private Sub UserForm_Initialize()
  255.     Dim isldcount As Integer
  256.     Dim i As Integer
  257.    
  258.     isldcount = ActivePresentation.Slides.Count
  259.     With Me
  260.         With .cbbSlide
  261.             For i = 1 To isldcount
  262.                 .AddItem ActivePresentation.Slides(i).Name
  263.             Next i
  264.             .ListIndex = ActiveWindow.Selection.SlideRange.SlideNumber - 1
  265.         End With
  266.         .mpReference.Value = 0
  267.     End With
  268. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2012-3-1 09:07 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
好贴呀,只能说这个空洞的话来表达自己的心情

TA的精华主题

TA的得分主题

发表于 2012-6-12 14:32 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2012-6-13 12:27 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2012-6-20 09:10 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2012-6-20 10:20 | 显示全部楼层
头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2012-6-24 09:55 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
提示: 作者被禁止或删除 内容自动屏蔽
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 02:16 , Processed in 0.053892 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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