li_hsien

回復 8# stillfish00


   

下載 (131 KB)
ERROR

2013-11-27 10:05

不知道為什麼執行起來會說巨集有問題
重開了也是一樣
不清楚錯在哪

我的執行方式是

1. Sub test()
   
2.     SetRangeFlashing Target:=Range("B2"), ColorIndex:=3
   
3. End Sub
   
4. 
   
5. Static Sub SetRangeFlashing(Optional Target, Optional ColorIndex, Optional bQuit As Boolean)
   
6.    
   
7.     '使用方法:
   
8.     '  要開始閃爍請呼叫：
   
9.     'SetRangeFlashing Target:=Range("B2"), ColorIndex:=3
   
10.     '  要停止閃爍請呼叫：SetRangeFlashing bQuit:=True
    
11. 
    
12.     Dim dteNextTime As Date
    
13.     Dim bStatus As Boolean
    
14.     Dim RecordColor
    
15.     Dim rngFlash As Range
    
16.    
    
17.     If bQuit Then
    
18.       rngFlash.Interior.ColorIndex = RecordColor
    
19.       Application.OnTime dteNextTime, "SetRangeFlashing", , False
    
20.     Else
    
21.       If Not IsMissing(Target) Then Set rngFlash = Target
    
22.       If Not IsMissing(ColorIndex) Then RecordColor = ColorIndex
    
23.      
    
24.       rngFlash.Interior.ColorIndex = IIf(bStatus, RecordColor, xlColorIndexNone)
    
25.       bStatus = Not bStatus
    
26.       dteNextTime = Now + TimeValue("00:00:01")
    
27.       Application.OnTime dteNextTime, "SetRangeFlashing"
    
28.     End If
    
29.    
    
30. End Sub

複製代碼

不知道這樣跑程式是不是正確的

麻煩大大幫我看看

謝謝  :   )

GBKEE

回復 10# li_hsien

1. Dim Rng As Range
   
2. Private Sub twinkle()
   
3.     Dim t As Date
   
4.     '設立 Rng的範圍 *********
   
5.     With Worksheets(1)
   
6.     For i = 1 To .Range("A65536").End(xlUp).Row
   
7.         If .Range("A" & i).Interior.Color = 255 Then
   
8.             .Range("A" & i).Interior.Color = -4105  '紅底的變成無填滿
   
9.             '******將欄位記下來 *****
   
10.             If Rng Is Nothing Then
    
11.                 Set Rng = Range("A" & i)
    
12.             Else
    
13.                 Set Rng = Union(Rng, Range("A" & i))
    
14.             End If
    
15.             '******將欄位記下來 *****
    
16.         End If
    
17.     Next
    
18.     End With
    
19.     t = Time
    
20.     '**********儲存格 閃爍  ******
    
21.     Do
    
22.     DoEvents
    
23.         If Time - t > TimeValue("00:00:01") Then
    
24.             t = Time
    
25.             Rng.Interior.Color = IIf(Rng.Interior.Color = 255, -4105, 255)
    
26.         End If
    
27.     Loop
    
28.     '**********儲存格 閃爍  ******
    
29. End Sub

複製代碼

回復 11# li_hsien
11# 的程式碼(請複製於一般模組 (Module1)中 試試
以下程式碼也是請複製於一般模組試試

1. Dim Rng As Range, Msg As Boolean    '在模組頂端設立這模組可用之變數
   
2. Sub twinkle()
   
3.     Msg = False
   
4.     '設立 Rng的範圍 *********
   
5.     With Worksheets(1)
   
6.         For i = 1 To .Range("A65536").End(xlUp).Row
   
7.             If .Range("A" & i).Interior.Color = 255 Then
   
8.                 .Range("A" & i).Interior.Color = -4105  '紅底的變成無填滿
   
9.                 '******將欄位記下來 *****
   
10.                 If Rng Is Nothing Then
    
11.                     Set Rng = Range("A" & i)
    
12.                 Else
    
13.                     Set Rng = Union(Rng, Range("A" & i))
    
14.                 End If
    
15.                 '******將欄位記下來 *****
    
16.             End If
    
17.         Next
    
18.     End With
    
19.     Application.Wait Time + #12:00:01 AM#  '等候1秒鐘
    
20.     SetRangeFlashing                       '執行這程序
    
21. End Sub
    
22. Private Sub SetRangeFlashing() '儲存格 閃爍
    
23.     If Msg = True Then
    
24.         Rng.Interior.Color = 255   '還原紅色
    
25.         Exit Sub
    
26.     End If
    
27.     Rng.Interior.Color = IIf(Rng.Interior.Color = 255, -4105, 255)
    
28.     Application.OnTime Time + #12:00:01 AM#, "SetRangeFlashing"
    
29. End Sub
    
30. Sub Stop_Flashing()   '停止儲存格閃爍
    
31.     Msg = True
    
32. End Sub

複製代碼

li_hsien

回復 12# GBKEE

請問一下板大
Q1:
Set Rng = Union(Rng, Range("A" & i))
union的用法是??? 把range("A"& i) 加入Rng裡面嗎??
Rng是陣列嗎??? 還是???

Q2:
  '**********儲存格 閃爍  ******
    Do
    DoEvents
        If Time - t > TimeValue("00:00:01") Then
            t = Time
            為什麼沒有看到往下累加的欄位數，Rng可以往下一欄位跑呀??? 單看這樣好像只是原地閃同一個
            Rng.Interior.Color = IIf(Rng.Interior.Color = 255, -4105, 255)
        End If
    Loop
    '**********儲存格 閃爍  ******

Q3:
另外還想請問板大
有什麼方法可以把陣列值一次印出來嗎??
而不用FOR迴圈跑



不好意思問題有點多

謝謝大大    :  )

GBKEE

回復 13# li_hsien
Q1:
     Set Rng = Union(Rng, Range("A" & i))
    union的用法是??? 把range("A"& i) 加入Rng裡面嗎?? :沒錯Rng是陣列嗎??? 是Range

1. 'Union 方法 傳回兩個或多個範圍的合併範圍。
   
2. Option Explicit
   
3. Sub EX()
   
4. Dim Rng As Range
   
5. Set Rng = [A1:A5]
   
6. Set Rng = Union([A1:A5], [C5:C15])
   
7. MsgBox Rng.Address
   
8. End Sub

複製代碼

Q2:
     為什麼沒有看到往下累加的欄位數，Rng可以往下一欄位跑呀??? 單看這樣好像只是原地閃同一個
     看 Q1: 的說明
Q3:
有什麼方法可以把陣列值一次印出來嗎?? 而不用FOR迴圈跑

1. Option Explicit
   
2. Sub EX()
   
3. Dim AR()
   
4. AR = Array(5, 10, 15, 20)
   
5. [A1].Resize(1, UBound(AR) + 1) = AR
   
6. [A5].Resize(UBound(AR) + 1) = Application.WorksheetFunction.Transpose(AR)
   
7. MsgBox Join(AR, vbLf)
   
8. 'WorksheetFunction.Transpose:轉置(工作表函數)
   
9. End Sub

複製代碼

li_hsien

回復 14# GBKEE

非常感謝板大

我又多了好多經驗值了!!!

:   )