Board logo

標題: [發問] 我的select case 為什麼執行起來像無窮迴圈?? [打印本頁]

作者: examsuper    時間: 2010-7-22 17:47     標題: 我的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    時間: 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又開始一個新迴圈
作者: examsuper    時間: 2010-7-23 11:05

回復 2# kimbal


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




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)