Code thời gian đếm ngược trong PPT

- 0 / 0
(Tài liệu chưa được thẩm định)
Nguồn:
Người gửi: Dương Quỳnh
Ngày gửi: 12h:18' 15-12-2018
Dung lượng: 13.3 KB
Số lượt tải: 29
Nguồn:
Người gửi: Dương Quỳnh
Ngày gửi: 12h:18' 15-12-2018
Dung lượng: 13.3 KB
Số lượt tải: 29
Số lượt thích:
0 người
Sub dem_nguoc()
Dim oshp As Shape
Dim oshpRng As ShapeRange
Dim osld As Slide
Dim oeff As Effect
Dim i As Integer
Dim Iduration As Integer
Dim Istep As Integer
Dim dText As Date
Dim texttoshow As String
On Error GoTo errhandler
If ActiveWindow.Selection.ShapeRange.Count > 1 Then
MsgBox "Hay chon mot doi tuong la shape!"
Exit Sub
End If
Set osld = ActiveWindow.Selection.SlideRange(1)
Set oshp = ActiveWindow.Selection.ShapeRange(1)
oshp.Copy
Istep = 1 `thoi gian nhay tung hinh
Iduration = 120 `so giay can dem
For i = Iduration To 0 Step -Istep
Set oshpRng = osld.Shapes.Paste
With oshpRng
.Left = oshp.Left
.Top = oshp.Top
End With
dText = CDate(i \ 3600 & ":" & ((i Mod 3600) \ 60) & ":" & (i Mod 60))
If Iduration < 60 Then
texttoshow = Format(dText, "Ss")
Else
If Iduration < 3600 Then
texttoshow = Format(dText, "Nn:Ss")
Else
texttoshow = Format(dText, "Hh:Nn:Ss")
End If
End If
oshpRng(1).TextFrame.TextRange = texttoshow
Set oeff = osld.TimeLine.MainSequence _
.AddEffect(oshpRng(1), msoAnimEffectFlashOnce, , msoAnimTriggerAfterPrevious)
oeff.Timing.Duration = Istep
Next i
oshp.Delete
Exit Sub
errhandler:
MsgBox "**ERROR** - Ban chua chon doi tuong?"
End Sub
Dim oshp As Shape
Dim oshpRng As ShapeRange
Dim osld As Slide
Dim oeff As Effect
Dim i As Integer
Dim Iduration As Integer
Dim Istep As Integer
Dim dText As Date
Dim texttoshow As String
On Error GoTo errhandler
If ActiveWindow.Selection.ShapeRange.Count > 1 Then
MsgBox "Hay chon mot doi tuong la shape!"
Exit Sub
End If
Set osld = ActiveWindow.Selection.SlideRange(1)
Set oshp = ActiveWindow.Selection.ShapeRange(1)
oshp.Copy
Istep = 1 `thoi gian nhay tung hinh
Iduration = 120 `so giay can dem
For i = Iduration To 0 Step -Istep
Set oshpRng = osld.Shapes.Paste
With oshpRng
.Left = oshp.Left
.Top = oshp.Top
End With
dText = CDate(i \ 3600 & ":" & ((i Mod 3600) \ 60) & ":" & (i Mod 60))
If Iduration < 60 Then
texttoshow = Format(dText, "Ss")
Else
If Iduration < 3600 Then
texttoshow = Format(dText, "Nn:Ss")
Else
texttoshow = Format(dText, "Hh:Nn:Ss")
End If
End If
oshpRng(1).TextFrame.TextRange = texttoshow
Set oeff = osld.TimeLine.MainSequence _
.AddEffect(oshpRng(1), msoAnimEffectFlashOnce, , msoAnimTriggerAfterPrevious)
oeff.Timing.Duration = Istep
Next i
oshp.Delete
Exit Sub
errhandler:
MsgBox "**ERROR** - Ban chua chon doi tuong?"
End Sub
 








Các ý kiến mới nhất