2

Wordファイルの特定のテーブルのセルから5列のExcelファイルを生成しようとしています(WordテーブルからExcelにコピー)。私のワードファイルには280のテーブルがあります。Word ファイルからコピーするセルのアドレス指定に問題はありません。結果が空のExcelファイルになる理由はわかりません。貼り付け方が間違っているのかも知れませんが…。これは私のコードです：

Sub copyfromwordtoexcel()
    Dim exApp As Excel.Application
    Dim exDoc As Excel.Workbook
    Set exApp = CreateObject("Excel.Application")
    Set exDoc = exApp.Workbooks.Add
    For xx = 1 To ActiveDocument.Tables.Count
    On Error Resume Next
    ActiveDocument.Tables(xx).Cell(2, 2).Range.Copy
    exApp.Visible = True
    Cells(xx, 1).Select
    ActiveSheet.Paste
    Application.Visible = True
    exApp.Visible = False
    ActiveDocument.Tables(xx).Cell(3, 2).Range.Copy
    exApp.Visible = True
    Cells(xx, 2).Select
    ActiveSheet.Paste
    i = ActiveDocument.Tables(xx).Rows.Count
    ActiveDocument.Tables(xx).Cell(i - 2, 2).Range.Copy
    exApp.Visible = True
    Cells(xx, 3).Select
    ActiveSheet.Paste
    Application.Visible = True
    ActiveDocument.Tables(xx).Cell(i - 1, 2).Range.Copy
    exApp.Visible = True
    Cells(xx, 4).Select
    ActiveSheet.Paste
    Application.Visible = True
    ActiveDocument.Tables(xx).Cell(i, 2).Range.Copy
    exApp.Visible = True
    Cells(xx, 5).Select
    ActiveSheet.Paste
    Application.Visible = True
    exApp.Visible = True
    Next
End Sub

ご協力いただきありがとうございます

4

1 に答える 1

0

いくつかのレビューの後、私はペーストでpastespecialを使用する必要があることがわかりました。修正されたコードは次のとおりです

Sub copyfromwordtoexcel()
Dim exApp As Excel.Application
Dim exDoc As Excel.Workbook
Set exApp = CreateObject("Excel.Application")
Set exDoc = exApp.Workbooks.Add
For xx = 1 To ActiveDocument.Tables.Count
On Error Resume Next
If ActiveDocument.Tables(xx).Columns.Count = 2 Then

ActiveDocument.Tables(xx).Cell(2, 2).Range.Copy
exApp.Visible = True
Cells(xx, 1).Select
ActiveSheet.PasteSpecial (xlPasteAll)

Application.Visible = True
exApp.Visible = False
ActiveDocument.Tables(xx).Cell(3, 2).Range.Copy
exApp.Visible = True
Cells(xx, 2).Select
ActiveSheet.PasteSpecial (xlPasteAll)
i = ActiveDocument.Tables(xx).Rows.Count
ActiveDocument.Tables(xx).Cell(i - 2, 2).Range.Copy
exApp.Visible = True
Cells(xx, 3).Select
ActiveSheet.PasteSpecial (xlPasteAll)
Application.Visible = True
ActiveDocument.Tables(xx).Cell(i - 1, 2).Range.Copy
exApp.Visible = True
Cells(xx, 4).Select
ActiveSheet.PasteSpecial (xlPasteAll)
Application.Visible = True
ActiveDocument.Tables(xx).Cell(i, 2).Range.Copy
exApp.Visible = True
Cells(xx, 5).Select
ActiveSheet.PasteSpecial (xlPasteAll)
Application.Visible = True
exApp.Visible = True
End If

Next

サブ終了

于 2012-08-27T10:10:08.257 に答える