Sub get_word_table( )
Dim wrdApp As Object
Set wrdApp = CreateObject("Word.Application") '建立引用Word應用程式的物件
Set wrdDoc = wrdApp.Documents.Open("D:\Temp\ole_test.doc") '引用Word文件
With wrdDoc.Tables(1)
For r = 1 To .Rows.Count
For c = 1 To .Columns.Count
Cells(r, c) = .Cell(r, c)
Next c
Next r
End With
wrdDoc.Close 'close the document
wrdApp.Quit 'close Word
Set wrdDoc = Nothing '釋放物件變數
Set wrdApp = Nothing
End Sub作者: iceandy6150 時間: 2014-2-6 22:27
不同檔案間的複製
Sub ex()
Dim Ar(), fd$, fs$, s%
fd = "D:\10月\" '更改成你的10月資料夾目錄 *****這邊你就改你想開的檔案的資料夾目錄
fs = Dir(fd & "*.xls")
Do Until fs = ""
With Workbooks.Open(fd & fs)
With .Sheets("模製")
ReDim Preserve Ar(s)
Ar(s) = Array(.[AP7].Value, .[AP10].Value, .[AP12].Value, .[G7].Value, .[G12].Value)
s = s + 1
End With
.Close 0
End With
fs = Dir
Loop
[A2].Resize(s, 5).Value = Application.Transpose(Application.Transpose(Ar))
End Sub
