- 帖子
- 47
- 主題
- 19
- 精華
- 0
- 積分
- 82
- 點名
- 0
- 作業系統
- win
- 軟體版本
- xp
- 閱讀權限
- 20
- 註冊時間
- 2014-7-4
- 最後登錄
- 2021-9-4
|
2#
發表於 2014-7-29 12:20
| 只看該作者
大家好
我找到之前版主回覆的資料
http://forum.twbts.com/thread-4838-1-1.html
但是直接利用上述的程式,會出現一些問題
由於我的excel表中是利用函數的方式，將word所貼進去的資料進行查找
而,直接利用上述程式,會出現貼入的字串無法利用excel中的函數進行查找的問題(詳細的原因,我也不清楚
因此,以下我針對上述問題進行改良後的程式(在word2003、2010及excel2003、2010皆測試可用- Sub test()
- [code]Sub test()
- Dim xlWkApp As Object, xlWk As Object
- Dim b, i, q As Integer
- Dim strSrcName As String
- i = 1
- Set xlWkApp = CreateObject("excel.application") '應用excel
- With xlWkApp
- .Visible = False '讓excel的執行不可見
- Set xlWk = .Workbooks.Open("excel範本的置放路徑") '開啟excel範本
- While i <= ActiveDocument.Tables(1).Rows.Count '設定i的循環為word中的第一個表格的總列數
- b = ThisDocument.Tables(1).Cell(i, 1) '擷取word中的table1中的cell(i,1)
- b = Left(b, Len(b) - 2) '選取word表格中的字串
- xlWk.Sheets("sheet名稱").Range("c" & i + 4) = b '將word表格中的字串,貼到excel中的c欄中
- ThisDocument.Tables(1).Cell(i, 2).Range.Text = xlWk.Sheets("sheet名稱").Range("d" & i + 4) '將excel的d欄中的值貼回word中的第二欄
- ThisDocument.Tables(1).Cell(i, 3).Range.Text = xlWk.Sheets("sheet名稱").Range("e" & i + 4) '將excel的e欄中的值貼回word中的第三欄
- i = i + 1
- Wend
- End With
- End Sub
|
|
