gamegamegamegame
Thành viên hoạt động



- Tham gia
- 5/6/15
- Bài viết
- 144
- Được thích
- 5
Sub dem_nguoc()
'Ma nguon duoc viet boi Bui Quang Hien
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
'Ma nguon duoc viet boi Bui Quang Hien
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?"
'Ma nguon duoc viet boi Bui Quang Hien
End Sub
em tìm được một tai lieu trên mang về đồng hồ điểm ngược
không biết đoạn code trên có thể làm cho slide1 nhảy qua slide khác đc ko
xin mọi người góp ý giúp
'Ma nguon duoc viet boi Bui Quang Hien
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
'Ma nguon duoc viet boi Bui Quang Hien
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?"
'Ma nguon duoc viet boi Bui Quang Hien
End Sub
em tìm được một tai lieu trên mang về đồng hồ điểm ngược
không biết đoạn code trên có thể làm cho slide1 nhảy qua slide khác đc ko
xin mọi người góp ý giúp
Lần chỉnh sửa cuối: