[發問] 求救~無限迴圈~

av8d

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     Application.DisplayAlerts = False
   
4.     If Target.Address(0, 0) = "A1" Then
   
5.    
   
6.         Dim Bo As Workbook, Save_Name  As String, E As Object
   
7.         
   
8.         With ActiveWorkbook
   
9.                                             
   
10.             Save_Name = "D:\" & [A1] & ".xls"
    
11.                 .Sheets("工作表1").Copy
    
12.         End With
    
13.         
    
14.         With ActiveWorkbook
    
15.             For Each E In .VBProject.VBComponent
    
16.                 E.CodeModule.DeleteLines 1, E.CodeModule.CountOfLines
    
17.             Next
    
18.             .SaveCopyAs Save_Name
    
19.             .Close False
    
20.         End With
    
21.         
    
22.         [A1].Select
    
23.     End If
    
24.    
    
25.     Application.DisplayAlerts = True
    
26. End Sub

複製代碼

我在 [A1].Select 下方新增一行 Selection.ClearContents
結果變成無限迴圈~不知道為什麼會這樣~懇求大大們幫忙~謝謝!

GBKEE

回復 1# av8d
這問題很常見,試試看

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim Bo As Workbook, Save_Name  As String, E As Object
   
3.     Application.EnableEvents = False   '停止物件的觸發事件
   
4.     Application.DisplayAlerts = False
   
5.     If Target.Address(0, 0) = "A1" Then        
   
6.         With ActiveWorkbook                                            
   
7.             Save_Name = "D:\" & [A1] & ".xls"
   
8.                 .Sheets("工作表1").Copy
   
9.         End With        
   
10.         With ActiveWorkbook
    
11.             For Each E In .VBProject.VBComponent
    
12.                 E.CodeModule.DeleteLines 1, E.CodeModule.CountOfLines
    
13.             Next
    
14.             .SaveCopyAs Save_Name
    
15.             .Close False
    
16.         End With
    
17.         [A1].Select
    
18.         Selection.ClearContents  '這工作表中的儲存格有修改
    
19.         '**  Worksheet_Change (這是工作中的儲存格有修改時->預設的觸發事件程序)
    
20.     End If
    
21.     Application.DisplayAlerts = True
    
22.     Application.EnableEvents = True  '恢復物件的觸發事件
    
23. End Sub

複製代碼

av8d

回復 2# GBKEE


    謝謝G大~完成
是否可以再詢問一下
我下了這個判斷[A1].Select
是希望輸入以後~依然維持在A1

但是當我滑鼠點到A2就不會跳到A1了
因為判斷有改變才執行

請問是否可以在滑鼠指到A1以外的儲存格
讓他自動跳到A1呢?不知道有沒有這種判斷?再次感謝!

GBKEE

回復 3# av8d

1. Option Explicit
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3.     If Target.Address(0, 0) <> "A1" Then [A1].Select
   
4. End Sub

複製代碼

下載 (25.1 KB)

2013-3-14 15:24