【VBA编程】从PPT宏简单使用到Visual Basic语言入门

此文包括:

  • PPT计数代码,不要看这个就吓跑了……
  • vba从入门变量到数组声明if循环语法到放弃

不做ppt倒好,一做便遭殃,想实现一个功能:

一个动作按钮,点击这个按钮,切换到下一张ppt,并且计数+1,然后在下一页显示出来。

然后发现宏应该能实现这个过程,现在我去探索一下:
首先,幻灯片(ppt)里的“宏”是嵌入到Powerpoint的visual basic程序,也就是为实现某一功能编写的指令。“宏”可以实现各种各样的功能,比如批量加入图片,加载倒计时等。

实现字数计算的代码:

Sub ChineseCounter()
    Dim sPrompt As String, sTitle As String, sDefault As Integer, sStart As String, sEnd As String
    sPrompt1 = "请输入起始页"
    sPrompt2 = "请输入结束页"
    sTitle = "输入数字"
    sDefault = 1
    sStart = InputBox(sPrompt1, sTitle, sDefault)
    Dim iNum As Integer, iCount As Integer
    iCount = 0
    iNum = ActivePresentation.Slides.count
    sEnd = InputBox(sPrompt2, sTitle, iNum)
    If (IsNumeric(sStart) And IsNumeric(sEnd) And CInt(sStart) <= CInt(sEnd)) Then
        Dim iStart As Integer, iEnd As Integer
        iStart = CInt(sStart)
        iEnd = CInt(sEnd)
        For a_counter = iStart To iEnd
            Set myDocument = ActivePresentation.Slides(a_counter)
            Dim str As String
            Dim iAsc As Integer
            Dim iLen As Integer
            Dim index As Integer
            For Each s In myDocument.Shapes
                If s.Type = msoGroup Then
                    index = s.GroupItems.count
                        While (index > 0)
                            If s.GroupItems.Item(index).HasTextFrame Then
                               With s.GroupItems.Item(index).TextFrame
                                  If .HasText Then
                                     str = .TextRange.Text
                                         iLen = Len(str)
                                         While iLen > 0
                                         iAsc = Asc(Right(str, iLen))
                                         If iAsc < 0 Then
                                              iCount = iCount + 1
                                         End If
                                              iLen = iLen - 1
                                         Wend
                                   End If
                                End With
                            End If
                            index = index - 1
                        Wend
                ElseIf s.Type = msoTable Then
                   For i = 1 To s.Table.Columns.count
                      For j = 1 To s.Table.Columns(i).Cells.count
                            If s.Table.Columns(i).Cells(j).shape.HasTextFrame Then
                               With s.Table.Columns(i).Cells(j).shape.TextFrame
                                  If .HasText Then
                                     str = .TextRange.Text
                                         iLen = Len(str)
                                         While iLen > 0
                                         iAsc = Asc(Right(str, iLen))
                                         If iAsc < 0 Then
                                              iCount = iCount + 1
                                         End If
                                              iLen = iLen - 1
                                         Wend
                                   End If
                                End With
                            End If
                      Next j
                   Next i
                   ElseIf s.Type = msoplaseholder Then
                        index = s.GroupItems.count
                        While (index > 0)
                            If s.PlaseHolders.Item(index).HasTextFrame Then
                               With s.PlaseHolders.Item(index).TextFrame
                                  If .HasText Then
                                     str = .TextRange.Text
                                         iLen = Len(str)
                                         While iLen > 0
                                         iAsc = Asc(Right(str, iLen))
                                         If iAsc < 0 Then
                                              iCount = iCount + 1
                                         End If
                                              iLen = iLen - 1
                                         Wend
                                   End If
                                End With
                            End If
                            index = index - 1
                        Wend

                Else
                    If s.HasTextFrame Then
                       With s.TextFrame
                          If .HasText Then
                             str = .TextRange.Text
                                 iLen = Len(str)
                                 While iLen > 0
                                 iAsc = Asc(Right(str, iLen))
                                 If iAsc < 0 Then
                                      iCount = iCount + 1
                                 End If
                                      iLen = iLen - 1
                                 Wend
                           End If
                        End With
                    End If
                End If
            Next
        Next a_counter
    End If
    MsgBox (iCount)
End Sub

似乎什么都看不懂!
运行结果
发现可以做倒计时,比赛演讲有看到那种倒计时,差点忘了
这个链接http://www.officezu.com/a/powerpoint/6931.html有,但是不是我想要的


时间到了零点,在寝室重新操刀时发现,原来是Visual Basic语言(VBA)写的!怪不得搜索宏搜不到有用的教程!

Visual Basic for Applications(VBA)是Visual Basic的一种宏语言,是微软开发出来在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。主要能用来扩展Windows的应用程序功能,特别是Microsoft Office软件。也可说是一种应用程式视觉化的Basic 脚本。该语言于1993年由微软公司开发的的应用程序共享一种通用的自动化语言——–Visual Basic For Application(VBA),实际上VBA是寄生于VB应用程序的版本。微软在1994年发行的Excel5.0版本中,即具备了VBA的宏功能。

开始当然是写魔教口号:Hello world啦!

 Sub mysub()
        MsgBox "Hello World"
       End Sub

运行结果: 这里写图片描述

Sub mysub()   
            Dim str As String '定义str作为字符串
            str = "Hello World"
            MsgBox (str)'开启一个窗体,显示Hello World
        End Sub

变量

这里写图片描述

这里写图片描述

If循环

Sub mysub()
            'Dim a As Byte
            'Dim b As Byte
            a = 1
            b = 2
            If a > b Then
                MsgBox "a大于b" '开启一个窗体,显示内容
             ElseIf a < b Then
                MsgBox "a小于b"
             Else
                MsgBox "a等于b"
            End If

        End Sub

运行结果: 这里写图片描述

数组& For循环

'数组简单使用,不过Tnteger换其他类型行不行?
Sub mysub()

                Dim arr(1 To 10) As Integer, i As Integer
                For i = 1 To 10
                arr(i) = i              'arr数组赋值
                MsgBox (arr(i))
                Next
                End Sub

运行结果:这里写图片描述 12345678910 这里写图片描述

写到这突然发现别人贴的代码高黑亮一键复制,是他们有会员吗,查了一圈无果……
好了,好像到这就是学习瓶颈了,容许我去兜兜转转一圈~

PPT计时器

Sub MakeTimer()
    Dim slTemp As Slide
    Dim shpTemp As Shape
    Dim effNew As Effect
    Dim bhvEff As AnimationBehavior
    Dim aptNewPoint As AnimationPoint
    Dim i As Integer
    Const sinPI As Single = 3.14159265

    Set slTemp = ActivePresentation.Slides.Add(1, ppLayoutBlank)
    With slTemp
        For i = 1 To 12
        'Draw oral shape
            Set shpTemp = .Shapes.AddShape(msoShapeOval, _
                                        100 + 50 * VBA.Sin((i - 1) * 30 / 180 * sinPI), _
                                        100 - 50 * VBA.Cos((i - 1) * 30 / 180 * sinPI), 20, 20)
            'Format shape
            With shpTemp
                .Fill.ForeColor.RGB = RGB(242, 242, 242)
                .Line.Visible = msoFalse
            End With
            'Add new animation effect, custom
            Set effNew = .TimeLine.MainSequence.AddEffect(shpTemp, _
                                msoAnimEffectCustom)
            effNew.EffectType = msoAnimEffectStyleEmphasis
            With effNew.Timing
                .Duration = 2.4 'Animation duration
                .TriggerType = msoAnimTriggerWithPrevious   'Animation trigger type, start with previous
                .TriggerDelayTime = (i - 1) * 0.2   'Delay timing
                .RepeatCount = 30       'Repeat times
                .RepeatDuration = 300   'Repeat duration, after that animation stops
                .Restart = msoAnimEffectRestartAlways   'Repeat automatically
            End With
            Set bhvEff = effNew.Behaviors.Add(msoAnimTypeProperty)  'Add animation behavious
            With bhvEff.PropertyEffect
                .Property = msoAnimColor        'Change color property
                Set aptNewPoint = .Points.Add   'Add animation points
                With aptNewPoint
                    .Time = 0
                    .Value = RGB(242, 242, 242)
                End With
                Set aptNewPoint = .Points.Add   'Add animation points
                With aptNewPoint
                    .Time = 0.2
                    .Value = RGB(180, 180, 180)
                End With
                Set aptNewPoint = .Points.Add   'Add animation points
                With aptNewPoint
                    .Time = 0.3
                    .Value = RGB(242, 242, 242)
                End With
                Set aptNewPoint = .Points.Add   'Add animation points
                With aptNewPoint
                    .Time = 1
                    .Value = RGB(242, 242, 242)
                End With
            End With
        Next i
    End With
End Sub

猜你喜欢

转载自blog.csdn.net/qq_42807924/article/details/81987183