[發問] 我的select case 為什麼執行起來像無窮迴圈??

請問各位先進，小弟想寫一個從選單儲存格選取後，依選取的人員各自進行一些處理，但不知為什麼trace時發現case區段內指令會一直重複執行，請教各位，謝謝~

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rowNo, colNo, countNo
Dim thisDate As String
Dim recStr As String
Dim sourceFile, backupFile

colNo = Selection.Columns.Column
rowNo = Selection.Rows.Row

thisDate = Str(Format(DateSerial(Year(Date), Month(Date), Day(Date)), "yyyymmdd"))

SetCurrentDirectoryA "\\econb\fs$\FS"
ChDir ".\資訊系統\系統測試"

If colNo = 2 Then                '如果選定測試人員(B)欄位

      Select Case Selection.Value

         Case "胡先生"

            countNo = Application.WorksheetFunction.CountIf([B1:B300], "胡先生")
            recStr = "H-" + thisDate + "-" + Str(countNo)
            Call genRecFile("胡先生", recStr, rowNo, colNo)
            Call callWord("胡先生", recStr)

         Case "王小姐"
            countNo = Application.WorksheetFunction.CountIf([B1:B300], "王小姐")
            recStr = "W-" + thisDate + "-" + Str(countNo)
            Call genRecFile("王小姐", recStr, rowNo, colNo)
            Call callWord("王小姐", recStr)
         Case "黃小姐"
            countNo = Application.WorksheetFunction.CountIf([B1:B300], "黃小姐")
            recStr = "F-" + thisDate + "-" + Str(countNo)
            Call genRecFile("黃小姐", recStr, rowNo, colNo)
               Call callWord("黃小姐", recStr)
         Case Else


      End Select
End If
'---------------------------------------------------------------------------------------------------------------
If colNo = 7 Then                   '如果選定提交廠商欄位
      Dim fileStr As String
         fileStr = Cells(rowNo, colNo - 3).Value & ".doc"
      Dim fsApp As Object
         Set fsApp = CreateObject("Scripting.FileSystemObject")
      '
      If Selection.Value = "提交" And Cells(rowNo, colNo - 3).Value <> "" Then       '如果提交且紀錄編號不等於空白
         '
         fsApp.Movefile ".\測試報告\" & fileStr, ".\待提交\"                                     '將word測試檔移到待提交目錄
         '
         Selection.Value = Selection.Value + "(" + thisDate + ")"
         Range(Cells(rowNo, colNo - 2), Cells(rowNo, colNo - 2)).Hyperlinks(1).Address = ".\待提交\" + fileStr

      ElseIf Selection.Value = "提交" And Cells(rowNo, colNo - 3).Value = "" Then
         MsgBox "測試報告WORD檔不存在!!"
         Selection.Value = ""
      ElseIf Selection.Value = "取消提交" And Cells(rowNo, colNo - 3).Value = "" Then
         MsgBox "測試報告WORD檔不存在!!"
         Selection.Value = ""
      ElseIf Selection.Value = "取消提交" And Cells(rowNo, colNo - 3).Value <> "" Then
         fsApp.Movefile ".\待提交\" & fileStr, ".\測試報告\"                                     '將WORD檔移回原目錄
         Range(Cells(rowNo, colNo - 2), Cells(rowNo, colNo - 2)).Hyperlinks(1).Address = ".\測試報告\" + fileStr
      Else


      End If

      Set fsApp = Nothing

End If
End Sub

Sub genRecFile(Name As String, ByVal recStr As String, ByVal rowNo, ByVal colNo)
      Cells(rowNo, colNo + 2) = recStr                                     '記錄編號欄位
      Cells(rowNo, colNo + 3).Select                                     '開啟測試報告欄位

      ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=".\測試報告\系統測試異常報告空白表單.doc" _
                           , TextToDisplay:="開啟"

      sourceFile = ".\測試報告\系統測試異常報告空白表單.doc"
      backupFile = ".\測試報告\" + recStr + ".doc"
      FileCopy sourceFile, backupFile
      Selection.Hyperlinks(1).Address = ".\測試報告\" + recStr + ".doc"                '設定開啟超連結
      Cells(rowNo, colNo + 1).Value = DateSerial(Year(Date), Month(Date), Day(Date))
End Sub

Sub callWord(Name As String, ByVal recStr As String)
         Dim WDAPP As Word.Application
         Set WDAPP = CreateObject("Word.Application")
            'Set WDDOC = GetObject(".\測試報告\" & recStr + ".DOC")
         WDAPP.Documents.Open "I:\資訊系統\系統測試\測試報告\" & recStr + ".DOC"
         WDAPP.Visible = True
            'Selection.Goto What:=wdGoToBookmark, Name:="recNo"

            'Selection.TypeText Text:=recStr    '在游標處打字
            'Selection.Paste
            ''Selection.TypeParagraph                         '新增一行
            'WDDOC.Save '儲存回原檔案(擇一選用即可)
            ''WDDOC.SaveAs "E:/ANY/COSMOS.DOC" '本行為另存新檔
         WDAPP.Quit '本行為操作完畢自動關掉WORD的功能
         Set WDAPP = Nothing

樓主熱帖

kimbal

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 472
主題: 5
精華: 0
積分: 485
點名: 0
作業系統: Windows
軟體版本: MS Office
閱讀權限: 100
性別: 男
來自: 香港
註冊時間: 2010-7-4
最後登錄: 2014-12-28

論壇貢獻勳章

2^#

發表於 2010-7-22 18:49 | 只看該作者

請問各位先進，小弟想寫一個從選單儲存格選取後，依選取的人員各自進行一些處理，但不知為什麼trace時發現c ...
examsuper 發表於 2010-7-22 17:47

試試
在worksheet_change的最前一行加
Application.EnableEvents = False
和在worksheet_change的最後一行加
application.EnableEvents = true

worksheet_change運行時有東西寫上worksheet,那麼worksheet_change又開始一個新迴圈

懂得發問,答案就會在其中

今日の一秒は明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

examsuper

小學生 Rank: 1

帖子: 14
主題: 6
精華: 0
積分: 25
點名: 0
作業系統: Windows XP
軟體版本: excel 2000
閱讀權限: 10
註冊時間: 2010-5-17
最後登錄: 2023-3-24

3^#

發表於 2010-7-23 11:05 | 只看該作者

回復 2# kimbal

謝謝Kimble，果真是如此，難怪我一直查閱select case用法，也看不出所以然來，謝謝~

TOP