ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] §Úªºselect case ¬°¤°»ò°õ¦æ°_¨Ó¹³µL½a°j°é??

[µo°Ý] §Úªºselect case ¬°¤°»ò°õ¦æ°_¨Ó¹³µL½a°j°é??

½Ð°Ý¦U¦ì¥ý¶i¡A¤p§Ì·Q¼g¤@­Ó±q¿ï³æÀx¦s®æ¿ï¨ú«á¡A¨Ì¿ï¨úªº¤H­û¦U¦Û¶i¦æ¤@¨Ç³B²z¡A¦ý¤£ª¾¬°¤°»òtrace®Éµo²{case°Ï¬q¤º«ü¥O·|¤@ª½­«½Æ°õ¦æ¡A½Ð±Ð¦U¦ì¡AÁÂÁÂ~

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 ".\¸ê°T¨t²Î\¨t²Î´ú¸Õ"
           
    If colNo = 2 Then                   '¦pªG¿ï©w ´ú¸Õ¤H­û(B)Äæ¦ì
        
        Select Case Selection.Value
            
            Case "­J¥ý¥Í"
               
                countNo = Application.WorksheetFunction.CountIf([B1:B300], "­J¥ý¥Í")
                recStr = "H-" + thisDate + "-" + Str(countNo)
                Call genRecFile("­J¥ý¥Í", recStr, rowNo, colNo)
                Call callWord("­J¥ý¥Í", recStr)
                                                        
            Case "¤ý¤p©j"
                countNo = Application.WorksheetFunction.CountIf([B1:B300], "¤ý¤p©j")
                recStr = "W-" + thisDate + "-" + Str(countNo)
                Call genRecFile("¤ý¤p©j", recStr, rowNo, colNo)
                Call callWord("¤ý¤p©j", recStr)
            Case "¶À¤p©j"
                countNo = Application.WorksheetFunction.CountIf([B1:B300], "¶À¤p©j")
                recStr = "F-" + thisDate + "-" + Str(countNo)
                Call genRecFile("¶À¤p©j", recStr, rowNo, colNo)
                 Call callWord("¶À¤p©j", recStr)           
            Case Else
        
        
        End Select
    End If
    '---------------------------------------------------------------------------------------------------------------
    If colNo = 7 Then                    '¦pªG¿ï©w ´£¥æ¼t°Ó Äæ¦ì
        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        '¦pªG´£¥æ¥B¬ö¿ý½s¸¹¤£µ¥©óªÅ¥Õ
           '
            fsApp.Movefile ".\´ú¸Õ³ø§i\" & fileStr, ".\«Ý´£¥æ\"                                        '±Nword´ú¸ÕÀɲ¾¨ì «Ý´£¥æ ¥Ø¿ý
           '
            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 "´ú¸Õ³ø§iWORDÀɤ£¦s¦b!!"
            Selection.Value = ""
        ElseIf Selection.Value = "¨ú®ø´£¥æ" And Cells(rowNo, colNo - 3).Value = "" Then
            MsgBox "´ú¸Õ³ø§iWORDÀɤ£¦s¦b!!"
            Selection.Value = ""
        ElseIf Selection.Value = "¨ú®ø´£¥æ" And Cells(rowNo, colNo - 3).Value <> "" Then
            fsApp.Movefile ".\«Ý´£¥æ\" & fileStr, ".\´ú¸Õ³ø§i\"                                       '±NWORDÀÉ ²¾¦^­ì¥Ø¿ý
            Range(Cells(rowNo, colNo - 2), Cells(rowNo, colNo - 2)).Hyperlinks(1).Address = ".\´ú¸Õ³ø§i\" + 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                                      '°O¿ý½s¸¹ Äæ¦ì
          Cells(rowNo, colNo + 3).Select                                        '¶}±Ò ´ú¸Õ³ø§i Äæ¦ì
               
          ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=".\´ú¸Õ³ø§i\¨t²Î´ú¸Õ²§±`³ø§iªÅ¥Õªí³æ.doc" _
                             , TextToDisplay:="¶}±Ò"
                                
          sourceFile = ".\´ú¸Õ³ø§i\¨t²Î´ú¸Õ²§±`³ø§iªÅ¥Õªí³æ.doc"
          backupFile = ".\´ú¸Õ³ø§i\" + recStr + ".doc"
          FileCopy sourceFile, backupFile
          Selection.Hyperlinks(1).Address = ".\´ú¸Õ³ø§i\" + recStr + ".doc"                   '³]©w ¶}±Ò ¶W³sµ²
          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(".\´ú¸Õ³ø§i\" & recStr + ".DOC")
            WDAPP.Documents.Open "I:\¸ê°T¨t²Î\¨t²Î´ú¸Õ\´ú¸Õ³ø§i\" & recStr + ".DOC"
            WDAPP.Visible = True
                'Selection.Goto What:=wdGoToBookmark, Name:="recNo"

                'Selection.TypeText Text:=recStr      '¦b´å¼Ð³B¥´¦r
                'Selection.Paste
                ''Selection.TypeParagraph                            '·s¼W¤@¦æ
                'WDDOC.Save    'Àx¦s¦^­ìÀÉ®×(¾Ü¤@¿ï¥Î§Y¥i)
                ''WDDOC.SaveAs "E:/ANY/COSMOS.DOC"   '¥»¦æ¬°¥t¦s·sÀÉ
            WDAPP.Quit   '¥»¦æ¬°¾Þ§@§¹²¦¦Û°ÊÃö±¼WORDªº¥\¯à
            Set WDAPP = Nothing

½Ð°Ý¦U¦ì¥ý¶i¡A¤p§Ì·Q¼g¤@­Ó±q¿ï³æÀx¦s®æ¿ï¨ú«á¡A¨Ì¿ï¨úªº¤H­û¦U¦Û¶i¦æ¤@¨Ç³B²z¡A¦ý¤£ª¾¬°¤°»òtrace®Éµo²{c ...
examsuper µoªí©ó 2010-7-22 17:47


¸Õ¸Õ
¦bworksheet_changeªº³Ì«e¤@¦æ¥[
    Application.EnableEvents = False
©M¦bworksheet_changeªº³Ì«á¤@¦æ¥[
application.EnableEvents = true

worksheet_change¹B¦æ®É¦³ªF¦è¼g¤Wworksheet,¨º»òworksheet_change¤S¶}©l¤@­Ó·s°j°é
À´±oµo°Ý,µª®×´N·|¦b¨ä¤¤

¤µ¤éの¤@¬íは  ©ú¤éにない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

¦^´_ 2# kimbal


    ÁÂÁÂKimble¡AªG¯u¬O¦p¦¹¡AÃø©Ç§Ú¤@ª½¬d¾\select case¥Îªk¡A¤]¬Ý¤£¥X©Ò¥HµM¨Ó¡AÁÂÁÂ~

TOP

        ÀR«ä¦Û¦b : ¤@­Ó¤H¤£©È¿ù¡A´N©È¤£§ï¹L¡A§ï¹L¨Ã¤£Ãø¡C
ªð¦^¦Cªí ¤W¤@¥DÃD