此文包括:
- 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