返回列表 上一主題 發帖

[發問] Excel 播放四個分頁

fantersy

帖子
132 
主題
35 
精華
0 
積分
179 
點名
0  
作業系統
Windows 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2014-12-24 
最後登錄
2025-1-17 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-6-13 17:06 | 只看該作者

[發問] Excel 播放四個分頁

各位先進好

有一問題想請教
小弟有四個分頁都在同一個檔案
想使用巨集讓四個分頁都能分別出現
就像PPT檔一樣輪播

小弟用了
Application.Wait waitTime
做延遲5秒後再其它分頁
但會卡住....
用了
Application.OnTime Now + TimeValue("00:00:05"), "我的分頁"
一樣會卡住
請問有別的語法或者小弟那邊寫錯了嗎?
收藏 分享

fantersy

帖子
132 
主題
35 
精華
0 
積分
179 
點名
0  
作業系統
Windows 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2014-12-24 
最後登錄
2025-1-17 
2#
發表於 2016-6-13 17:37 | 只看該作者
回復 1# fantersy


    各位先進好!!
小弟用下列語法寫出...
是可以執行....
請問有更好的寫法嗎??
另外可以設定熱鍵開始跟關閉嗎?

Sub 輪播()
For X = 1 To 5

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 5 + X
newSecond1 = Second(Now()) + 10 + X
newSecond2 = Second(Now()) + 15 + X
newSecond3 = Second(Now()) + 20 + X
waitTime = TimeSerial(newHour, newMinute, newSecond)
waitTime1 = TimeSerial(newHour, newMinute, newSecond1)
waitTime2 = TimeSerial(newHour, newMinute, newSecond2)
waitTime3 = TimeSerial(newHour, newMinute, newSecond3)

Sheets("生產日報表-焊錫線").Select
ActiveWindow.ScrollColumn = 1
Application.Wait waitTime

Sheets("生產日報表-組立一線").Select
ActiveWindow.ScrollColumn = 1

Application.Wait waitTime1

Sheets("生產日報表-組立二線").Select
ActiveWindow.ScrollColumn = 1

Application.Wait waitTime2

Sheets("生產日報表-測試線").Select
ActiveWindow.ScrollColumn = 1
Application.Wait waitTime3

Next


End Sub

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 2016-6-14 09:56 | 只看該作者
回復 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

fantersy

帖子
132 
主題
35 
精華
0 
積分
179 
點名
0  
作業系統
Windows 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2014-12-24 
最後登錄
2025-1-17 
4#
發表於 2016-6-14 13:31 | 只看該作者
回復 3# stillfish00

好厲害的寫法!!
謝謝大大的幫忙~真的受教了
學到不少~感恩!!

TOP

fantersy

帖子
132 
主題
35 
精華
0 
積分
179 
點名
0  
作業系統
Windows 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2014-12-24 
最後登錄
2025-1-17 
5#
發表於 2016-6-14 13:53 | 只看該作者
回復 3# stillfish00


    stillfish00 大大你好!!
小弟剛測試了一下!!
1.所有分頁都能輪放一次, 請問能指定某些分頁嗎?
2.輪放一次後即停止，請問能一直輪放到下熱鍵停止後才停的動作嗎?

抱歉!!麻煩大大解惑

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
6#
發表於 2016-6-14 17:20 | 只看該作者
回復 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

fantersy

帖子
132 
主題
35 
精華
0 
積分
179 
點名
0  
作業系統
Windows 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2014-12-24 
最後登錄
2025-1-17 
7#
發表於 2016-6-16 20:46 | 只看該作者
回復  fantersy
stillfish00 發表於 2016-6-14 17:20


謝謝大大的幫忙

真的很受用!!感恩!!

TOP

        靜思自在 : 稻穗結得越飽滿，越會往下垂，一個人越有成就，就要越有謙沖的胸襟。
返回列表 上一主題