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

[µo°Ý] excel VBA ¦p¦ó¦bwordÀɶ}±Òª¬ºA¤U¶¶§Q¼g¤Jwordªºªí®æ

[µo°Ý] excel VBA ¦p¦ó¦bwordÀɶ}±Òª¬ºA¤U¶¶§Q¼g¤Jwordªºªí®æ

§Ú·Q§Q¥Îexcel VBA §@¤@­Óªí³æ¿é¤J¸ê®Æ«á¡A­n¸ê®Æ¼g¤Jwordªºªí®æ¡A
§Úªº§@ªk¬O1.¥ýÀˬdwordÀɬO§_¶}±Ò¡A¦pªG¤w¶}±Ò¡A¥h°õ¦æ101µ{§Ç
¡@¡@¡@¡@¡@2.¦pªG¥¼¶}±Ò¡A«h¶}±ÒwordÀÉ«á¥h°õ¦æ101µ{§Ç
¡@¡@¡@¡@¡@3.¦pªG¬O·s専®×¡A«h±q¸ê®Æ§¨½Æ»sªÅ¥Õ専®×ºÞ¬°·s専®×¶i«×ªí«á¡A¥h°õ¦æ101µ{§Ç
¥Ø«e2. 3.³£¥i¥H¶¶§Q°õ¦æ
¦ý¬O1.·|¥X²{¿ù»~¦p¤U¹Ï¡A¤]´N¬O·íwordÀɶ}±Òª¬ºA¤U¡AµLªk¥¿±`°õ¦æ


³Â·Ð¦U¦ì¥ý¶i«ü¾É¤@¤U¡A¦p¦ó§JªA³o­Ó°ÝÃD
ÁÂÁÂ

µ{¦¡½X¦p¤U¡G
  1. Function IsFileOpen(strFile As String) As Boolean
  2.     Dim iFile As Integer
  3.     Dim iErr As Integer
  4.    
  5.     On Error Resume Next
  6.     iFile = FreeFile()
  7.     Open strFile For Input Lock Read As #iFile  '¥HÂê©w¤è¦¡¶}±Ò¡A¶}±Ò«ü©wÀɮ׫᪽±µÃö³¬ÀÉ®×
  8.     Close iFile
  9.    
  10.     iErr = Err  '±N¿ù»~¸¹½X±a¤JiErrÅܼƤ¤¡AµM«á¨Ì·Ó¼Æ¦r§Y¥i±oª¾Àɮת¬ºA
  11.     On Error GoTo 0
  12.     Select Case iErr
  13.         Case 0
  14.             IsFileOpen = False
  15.         Case 70
  16.             IsFileOpen = True
  17.         Case 53
  18.             MsgBox "§ä¤£¨ìÀɮסA±N«Ø¥ßªÅ¥Õ¶i«×ºÞ¨îªí¡I"
  19.             IsFileOpen = False
  20.         Case 76
  21.             MsgBox "§ä¤£¨ì¸ô®|¡A½Ð¦A½T»{¡I"
  22.             IsFileOpen = False
  23.     End Select
  24. End Function

  25. Sub CheckFile()
  26.     Dim strPath As String
  27.     Dim strFile As String
  28.     Dim strWordFile As String
  29.    
  30.     Set wordApp = CreateObject("Word.Application")
  31.     Set fs = CreateObject("Scripting.FileSystemObject")
  32.    
  33.     strFile = "¥_°Ï1.docx"
  34.     strPath = "D:\My Documents\Temp\"
  35.     strWordFile = strPath & strFile
  36.    
  37.    
  38.     If IsFileOpen(strWordFile) Then
  39.         GoTo 101
  40.     ElseIf fs.FileExists(strWordFile) Then
  41.         Set wordDoc = wordApp.Documents.Open(strWordFile)
  42.         wordApp.Visible = True
  43.         wordDoc.Activate
  44.         GoTo 101
  45.     Else
  46.         FileCopy strPath & "ªÅ¥Õ®×¥ó¶i«×ºÞ±±ªí.docx", strWordFile
  47.         Set wordDoc = wordApp.Documents.Open(strWordFile)
  48.         wordApp.Visible = True
  49.         wordDoc.Activate
  50.         GoTo 101
  51.         'MsgBox ("Àɮפ£¦s¦b¡I")
  52.         'Exit Sub
  53.     End If
  54.         
  55. 101:
  56.     With wordDoc.Tables(1)
  57.         .Cell(6, 2) = Replace(.Cell(6, 2), Chr(13), "") & "¡B³o¬O´ú¸Õ"
  58.         
  59.     '¨ú±owordªº¤é(®É)¼Æ¡A­«·s­pºâÁ`¤u§@®É¼Æ
  60.         If InStr(.Cell(6, 3), "¤é") = 0 And InStr(.Cell(6, 3), "¤p®É") = 0 Then
  61.             WorkHours = 0
  62.             GoTo 102
  63.         Else
  64.             xString = .Cell(6, 3)
  65.             xtemp = Split(xString, "¤é")
  66.             hours = Val(xtemp(0)) * 8
  67.             xtemp = Split(xtemp(1), "¤p®É")
  68.             WorkHours = hours + Val(xtemp(0))
  69.         End If
  70. 102:
  71.         '¥[·s¼W®É¼Æ:¹w­p¼W¥[4.5¤p®É
  72.         WorkHours = WorkHours + 4.5
  73.         '­pºâ¤é¼Æ(¨C8¤p®É¬°1¤é)
  74.         days = Int(WorkHours / 8)
  75.         '­pºâ³Ñ¾l¤p®É
  76.         hours = WorkHours - days * 8

  77.         '¼g¦^wordªí®æ
  78.         .Cell(6, 3) = days & "¤é" & hours & "¤p®É"

  79.     End With
  80.     'wordDoc.Close 'Ãö³¬¸ÓWord¤å¥óÀÉ
  81.     'wordApp.Quit 'µ²§ôWordÀ³¥Îµ{¦¡
  82.     'Set wordDoc = Nothing   'ÄÀ©ñª«¥óÅܼÆwordDoc
  83.     'Set wordApp = Nothing   'ÄÀ©ñª«¥óÅܼÆwordApp

  84. End Sub
½Æ»s¥N½X
wordÀɪþ¥ó
Temp.rar (57.63 KB)

¥»©«³Ì«á¥Ñ pipi1968 ©ó 2017-1-5 19:33 ½s¿è

¤w¸Ñ¨M¤F
¤Wºô¬d¤F¦n¤[¡A²×©óOK¤F
´£¨Ñµ¹»Ý­nªº¤H°Ñ¦Ò
  1. Function IsFileOpen(strFile As String) As Boolean
  2.     Dim iFile As Integer
  3.     Dim iErr As Integer
  4.    
  5.     On Error Resume Next
  6.     iFile = FreeFile()
  7.     Open strFile For Input Lock Read As #iFile  '¥HÂê©w¤è¦¡¶}±Ò¡A¶}±Ò«ü©wÀɮ׫᪽±µÃö³¬ÀÉ®×
  8.     Close iFile
  9.    
  10.     iErr = Err  '±N¿ù»~¸¹½X±a¤JiErrÅܼƤ¤¡AµM«á¨Ì·Ó¼Æ¦r§Y¥i±oª¾Àɮת¬ºA
  11.     On Error GoTo 0
  12.     Select Case iErr
  13.         Case 0
  14.             IsFileOpen = False
  15.         Case 70
  16.             IsFileOpen = True
  17.         Case 53
  18.             MsgBox "§ä¤£¨ìÀɮסA±N«Ø¥ßªÅ¥Õ¶i«×ºÞ¨îªí¡I"
  19.             IsFileOpen = False
  20.         Case 76
  21.             MsgBox "§ä¤£¨ì¸ô®|¡A½Ð¦A½T»{¡I"
  22.             IsFileOpen = False
  23.     End Select
  24. End Function

  25. Sub CheckFile()
  26.     Dim strPath As String
  27.     Dim strFile As String
  28.     Dim strWordFile As String
  29.     Dim wordDoc As Object

  30.     Set wordApp = CreateObject("Word.Application")
  31.     Set fs = CreateObject("Scripting.FileSystemObject")
  32.      
  33.     strFile = "¥_°Ï1.docx"
  34.     strPath = "D:\My Documents\Temp\"
  35.     strWordFile = strPath & strFile
  36.    
  37.    
  38.     If IsFileOpen(strWordFile) Then
  39.       Set wordDoc = GetObject(strWordFile)
  40.       Application.Visible = True
  41.       GoTo 101
  42.     ElseIf fs.FileExists(strWordFile) Then
  43.         Set wordDoc = wordApp.Documents.Open(strWordFile)
  44.         wordApp.Visible = True
  45.         wordDoc.Activate
  46.         GoTo 101
  47.     Else
  48.         FileCopy strPath & "ªÅ¥Õ®×¥ó¶i«×ºÞ±±ªí.docx", strWordFile
  49.         Set wordDoc = wordApp.Documents.Open(strWordFile)
  50.         wordApp.Visible = True
  51.         wordDoc.Activate
  52.         GoTo 101
  53.         'MsgBox ("Àɮפ£¦s¦b¡I")
  54.         'Exit Sub
  55.     End If
  56.         
  57. 101:
  58.     With wordDoc.Tables(1)
  59.         .Cell(6, 2) = Replace(.Cell(6, 2), Chr(13), "") & "¡B³o¬O´ú¸Õ"
  60.         
  61.     '¨ú±owordªº¤é(®É)¼Æ¡A­«·s­pºâÁ`¤u§@®É¼Æ
  62.         If InStr(.Cell(6, 3), "¤é") = 0 And InStr(.Cell(6, 3), "¤p®É") = 0 Then
  63.             WorkHours = 0
  64.             GoTo 102
  65.         Else
  66.             xString = .Cell(6, 3)
  67.             xtemp = Split(xString, "¤é")
  68.             hours = Val(xtemp(0)) * 8
  69.             xtemp = Split(xtemp(1), "¤p®É")
  70.             WorkHours = hours + Val(xtemp(0))
  71.         End If
  72. 102:
  73.         '¥[·s¼W®É¼Æ:¹w­p¼W¥[4.5¤p®É
  74.         WorkHours = WorkHours + 4.5
  75.         '­pºâ¤é¼Æ(¨C8¤p®É¬°1¤é)
  76.         days = Int(WorkHours / 8)
  77.         '­pºâ³Ñ¾l¤p®É
  78.         hours = WorkHours - days * 8

  79.         '¼g¦^wordªí®æ
  80.         .Cell(6, 3) = days & "¤é" & hours & "¤p®É"

  81.     End With
  82.     'wordDoc.Close 'Ãö³¬¸ÓWord¤å¥óÀÉ
  83.     'wordApp.Quit 'µ²§ôWordÀ³¥Îµ{¦¡
  84.     'Set wordDoc = Nothing   'ÄÀ©ñª«¥óÅܼÆwordDoc
  85.     'Set wordApp = Nothing   'ÄÀ©ñª«¥óÅܼÆwordApp

  86. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD