[發問] 讀取表格

kannas

請問如何用Excel 的VB，寫成讀取word的表格，
並把它轉變在Excel上面，格式要跟word上的一樣。

et5323

你可以参考下这里:
http://forum.twbts.com/viewthrea ... &page=1#pid9388

提问题最好有附件.

kannas

我指的是程式執行時，
會自動讀取指定路徑的word檔案，
並把檔案寫回Excel上面，
但我希望他的格式不會變。

有點像是
http://tw.myblog.yahoo.com/jw!_DIL5waFHwVKfL8odMZ4urti/article?mid=1617&prev=1572&next=1615&l=f&fid=16
這個的程式
但是我用這個弄，格式會變，雖然位子一樣，但格式卻沒了。

kimbal

我指的是程式執行時，
會自動讀取指定路徑的word檔案，
並把檔案寫回Excel上面，
但我希望他的格式不會變 ...
kannas 發表於 2010-12-1 01:05

   一個非常懶的方法
copy and paste....

1. Sub dsa()
   
2.        Dim Wd   'Word
   
3.        Dim Dc   '文件
   
4.        Dim Tb   '內表
   
5.        Dim i, j    '定位
   
6.    
   
7.            Sheet1.UsedRange.EntireRow.Delete    'Excel Sheet1 清表
   
8.            Set Wd = CreateObject("Word.Application")
   
9.            Dim RgR As Range
   
10.            Set Dc = Wd.Documents.Open("C:\temp\1.DOC ") '檔名
    
11.            Wd.Visible = True
    
12.            With Wd.Selection.Find
    
13.                 .Text = "^l"
    
14.                 .Replacement.Text = " "
    
15.             End With
    
16.             Wd.Selection.Find.Execute Replace:=2
    
17.             With Wd.Selection.Find
    
18.                 .Text = "^p"
    
19.                 .Replacement.Text = " "
    
20.             End With
    
21.             Wd.Selection.Find.Execute Replace:=2
    
22.            For Each Tb In Dc.tables
    
23.                Set RgR = Sheet1.UsedRange.EntireRow.Offset(Sheet1.UsedRange.Rows.Count + 1, 0).Cells(1)
    
24.                Tb.Range.Copy
    
25.                RgR.Select
    
26.                ActiveSheet.PasteSpecial Format:="HTML"
    
27.            Next
    
28.          
    
29.            Wd.Quit
    
30. End Sub

複製代碼

kannas

我的表格上有些格內有分行
我想讓他在Excel內只在一個格想用Chr來分行

上面那個程式他會更改到word的資料，變得每次都會問是否存word檔案

可以的話可以解釋每個程式的意思嗎?
因為我有些看不懂，我想了解每步驟的意思。
感謝。

Hsieh

回復 5# kannas

1. Sub WriteWordTb()
   
2. Dim Tb As Table, Ar()
   
3. Set Wd = CreateObject("Word.Application") '創建WORD程式物件
   
4. Cells.Clear '清空工作表內容
   
5. With Wd '關於WORD程式物件
   
6.   With .Documents.Open(ThisWorkbook.Path & "\1.doc") '開啟指定的檔案
   
7.     For Each Tb In .tables 'doc文件中的每個Table
   
8.     For i = 1 To Tb.Rows.Count
   
9.         For j = 1 To Tb.Columns.Count
   
10.            For s = 0 To Tb.Cell(i, j).Range.Sentences.Count - 1
    
11.               ReDim Preserve Ar(s)
    
12.               Ar(s) = Tb.Cell(i, j).Range.Sentences(s + 1)
    
13.            Next
    
14.          mystr = Join(Ar, Chr(10))
    
15.         Cells(i, j) = mystr
    
16.         Erase Ar
    
17.         Next
    
18.     Next
    
19.     Next
    
20.   End With
    
21.   .Quit '關閉程式
    
22. End With
    
23. End Sub

複製代碼

kannas

回復 6# Hsieh


    這個程式無法執行耶
   它顯示編譯錯誤:  使用者自訂型態尚未定義

Hsieh

]回復 7# kannas


    須引用項目
MicroSoft Word 12.0 Object Library

下載 (36.87 KB)

2010-12-17 20:12

或取消Tb變數宣告

1. Sub WriteWordTb()
   
2. Dim Ar()
   
3. Set Wd = CreateObject("Word.Application") '創建WORD程式物件
   
4. Cells.Clear '清空工作表內容
   
5. With Wd '關於WORD程式物件
   
6.   With .Documents.Open(ThisWorkbook.Path & "\1.doc") '開啟指定的檔案
   
7.     For Each Tb In .tables 'doc文件中的每個Table
   
8.     For i = 1 To Tb.Rows.Count
   
9.         For j = 1 To Tb.Columns.Count
   
10.            For s = 0 To Tb.Cell(i, j).Range.Sentences.Count - 1
    
11.               ReDim Preserve Ar(s)
    
12.               Ar(s) = Tb.Cell(i, j).Range.Sentences(s + 1)
    
13.            Next
    
14.          mystr = Join(Ar, Chr(10))
    
15.         Cells(i, j) = mystr
    
16.         Erase Ar
    
17.         Next
    
18.     Next
    
19.     Next
    
20.   End With
    
21.   .Quit '關閉程式
    
22. End With
    
23. End Sub

複製代碼

kannas

回復 8# Hsieh


   請問我用上面那個程式後，因為有些表格內他的字數有點小多，
  用自動調整欄寬的話，整個表格就會破壞掉，變得很寬。
  像是有一串字，點下格子內他會顯示全部的字，如果沒點就只顯示表格大小所能顯示的字數，其他則不顯示，
  可以把它弄成像是自動換行嗎?
   讓表格看起來不會很奇怪?

   問了這麼多  真是麻煩各位了  謝謝!!!

Hsieh

所以，妳並非要讓文字依據WORD表格內容換行
那就設定EXCEL自動換列

1. Sub WriteWordTb()
   
2. Dim Tb As Table, Ar()
   
3. Set Wd = CreateObject("Word.Application") '創建WORD程式物件
   
4. Cells.Clear '清空工作表內容
   
5. With Wd '關於WORD程式物件
   
6.   With .Documents.Open(ThisWorkbook.Path & "\1.doc") '開啟指定的檔案
   
7.     For Each Tb In .tables 'doc文件中的每個Table
   
8.     For i = 1 To Tb.Rows.Count
   
9.         For j = 1 To Tb.Columns.Count
   
10.            For s = 0 To Tb.Cell(i, j).Range.Sentences.Count - 1
    
11.               ReDim Preserve Ar(s)
    
12.               Ar(s) = Tb.Cell(i, j).Range.Sentences(s + 1)
    
13.            Next
    
14.          mystr = Join(Ar, Chr(10))
    
15.         With Cells(i, j)
    
16.         .Value = mystr
    
17.         .WrapText = True
    
18.         End With
    
19.         Erase Ar
    
20.         Next
    
21.     Next
    
22.     Next
    
23.   End With
    
24.   .Quit '關閉程式
    
25. End With
    
26. End Sub

複製代碼