2015-07-20 57 views
1

我需要將帶有大量表格的Word文檔導入到Excel工作表中。這很容易,但需要注意的是在輸入excel時保留word doc的格式。例如,字中的一些字段是藍色,一些是紅色。一些是藍色的下劃線,一些是紅色的下劃線。基本上,單詞doc中的任何顏色都需要在Excel表單中匹配。這是我進行實際導入的代碼。通過格式化將Word表格導入excel

Sub ImportWordTables_1() 
    Dim wdDoc As Object 
    Dim wdFileName As Variant 
    Dim TableNo As Long 'table number in Word 
    Dim iRow As Long 'row index in Excel 
    Dim iCol As Long 'column index in Excel 
    Dim tblCount As Long 
    wdFileName = Application.GetOpenFilename("Word files,*.doc;*.docx", , _ 
     "Browse for file containing table to be imported") 
    If wdFileName = False Then Exit Sub '(user cancelled import file browser) 
    Set wdDoc = GetObject(wdFileName) 'open Word file 
    With wdDoc 
     TableNo = wdDoc.tables.Count 
     If TableNo = 0 Then 
      MsgBox "This document contains no tables", vbExclamation, "Import Word Table" 
     End If 
     tblStart = InputBox("Enter table number to start with", "Table Start") 
     iCol = 1 
     For tblCount = tblStart To .tables.Count 
      With .tables(tblCount) 
       'copy cell contents from Word table cells to Excel cells 
       For iRow = 1 To .Rows.Count 
        'find the last empty row in the current worksheet 
        nextRow = ThisWorkbook.ActiveSheet.Range("a" _ 
         & Rows.Count).End(xlUp).Row + 1 
        'Just 1 column for now 
        'For iCol = 1 To .Columns.Count 
        ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = WorksheetFunction _ 
         .Clean(.cell(iRow, iCol).Range.Text) 
        'ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = _ 
         .cell(iRow, iCol).Range.Text 
        'Next iCol 
       Next iRow 
      End With 
     Next 
    End With 
    Set wdDoc = Nothing 
End Sub 
+0

您的代碼正在傳輸正常,但它不保留格式,是否正確? – Raystafarian

+1

http://stackoverflow.com/q/12245525/1161309 – Raystafarian

+0

我不確定如何修改我的代碼以適合鏈接中的示例。我只想要單詞表中的第一列。 –

回答

1

嘗試更換這條線 -

ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = WorksheetFunction _ 
.Clean(.cell(iRow, iCol).Range.Text) 

用這個代替 -

.cell(iRow, iCol).Range.Copy 
ThisWorkbook.ActiveSheet.Cells(nextrow, iCol).Activate 
ThisWorkbook.ActiveSheet.Paste 

很明顯,你可以通過使用一些變量有點清理它,但是這是基本的想法。

+0

感謝此代碼。這工作得很好,但速度要慢很多,並且帶來了很多我不想要的東西。我想要的只是前景色,背景色和粗體,下劃線或刪除線。我可以在複製和粘貼後清理它,但這並不能幫助它需要5倍的時間。 –

+0

然後更改粘貼到pastespecial並選擇你需要的東西? – Raystafarian

+0

我已經試過了。至少,手動做。確實沒有太多選擇。 –