我的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

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

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

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