返回列表 上一主題 發帖

[發問] Excel 播放四個分頁

回復 2# fantersy
以下放在ThisWorkbook , 開檔案時定義好熱鍵
  1. Private Sub Workbook_Open()
  2.     Application.OnKey "^+a", "AutoPlay"     'Ctrl + Shift + a  開始
  3.     Application.OnKey "^+s", "StopPlay"     'Ctrl + Shift + s  停止
  4. End Sub
複製代碼
以下放在一般模組
  1. Private inPlay As Boolean
  2. Private nextTime As Date
  3. Private index As Long
  4. Sub AutoPlay()
  5.     StopPlay    'stop previous schedule
  6.    
  7.     inPlay = True
  8.     index = 1
  9.     LoopDisplaySheet
  10. End Sub
  11. Sub StopPlay()
  12.     If inPlay Then
  13.         Application.OnTime nextTime, "LoopDisplaySheet", , False    '取消已存在排程
  14.         inPlay = False
  15.     End If
  16. End Sub
  17. Sub LoopDisplaySheet()
  18.     Application.Goto Sheets(index).Range("A1"), True
  19.    
  20.     If index = Sheets.Count Then
  21.         Exit Sub
  22.     Else
  23.         nextTime = Now + TimeValue("00:00:01")
  24.         index = index + 1
  25.         Application.OnTime nextTime, "LoopDisplaySheet"
  26.     End If
  27. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

回復 5# fantersy
  1. Private nextTime As Date
  2. Private index As Long
  3. Sub AutoPlay()
  4.     StopPlay    'stop previous schedule
  5.    
  6.     index = 0
  7.     LoopDisplaySheet
  8. End Sub
  9. Sub StopPlay()
  10.     On Error Resume Next
  11.     Application.OnTime nextTime, "LoopDisplaySheet", , False    '取消已存在排程
  12. End Sub
  13. Sub LoopDisplaySheet()
  14.     Dim arSheets
  15.     arSheets = Array("工作表1", "工作表2", "工作表3")
  16.    
  17.     Application.Goto Sheets(arSheets(index)).Range("A1"), True
  18.    
  19.     If index = UBound(arSheets) Then
  20.         index = 0
  21.     Else
  22.         index = index + 1
  23.     End If
  24.         
  25.     nextTime = Now + TimeValue("00:00:01")
  26.     Application.OnTime nextTime, "LoopDisplaySheet"
  27. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

        靜思自在 : 時時好心就是時時好日。
返回列表 上一主題