Question

怎么利用 VBA 将excel中的数据提取到word指定位置中？

将range("A1:A12")中的数据复制到word指定表格中可以吗？
不胜感激！！！下面是相应的word宏，不过有几处问题，不知怎么改？？
Public Sub lllkk()
Dim xLApp
Dim xlBook
Dim docApp
Dim newDoc
Dim thisPath, thisName As String
FileDir = "C:\新建文件夹\1.xls"
On Error Resume Next
Set xLApp = GetObject(, "Excel.Application") '判断Excel是否打开
If Err.Number <> 0 Then
Set xLApp = CreateObject("Excel.Application") '创建EXCEL对象
xLApp.Visible = True '设置EXCEL对象可见
End If
Err.Clear
Set xlBook = xLApp.Workbooks.Open(FileDir) '打开工件簿文件
xlBook.Visible = True
thisPath = ActiveWorkbook.Path & "\"
thisName = Range("a1")

Range("A1:A12").Select
Selection.Copy'''''''''''''''''''''''''这个貌似不执行啊
Range("C1:C12").Select
ActiveSheet.Paste''''''''''''''''''这个也就不执行了

Windows("1.doc").Activate''''''''''''''这个word含有表格，处于打开状态
Selection.HomeKey wdStory
Selection.MoveDown Unit:=wdLine, Count:=11, Extend:=wdExtend
Selection.paste''''''''''''''''''''这个不知道有没有写错

FileDir = "C:\新建文件夹\1.xls"
Set xLApp = GetObject(, "Excel.Application")
Set xlBook = xLApp.Workbooks.Open(FileDir) '打开工件簿文件
xLApp.Visible = True
docApp.Quit
Set docApp = Nothing
xLApp.Activate
xLApp.Quit
Set xLApp = Nothing
End Sub

excel跟word之间编辑宏有什么“讲究”呢？？
tables(1).cells(1,1).paste
改成
Selection.HomeKey wdStory
Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
Selection.Paste
可以用了，谢谢！

Answer 1

试了一下 下面的代码可以：
Public Sub lllkk()
Dim xlApp
Dim xlBook
Dim xlSheet
Dim docApp
Dim newDoc
Dim thisPath, thisName As String
FileDir = "C:\新建文件夹\1.xls"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application") '判断Excel是否打开
If Err.Number <> 0 Then
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
xlApp.Visible = True '设置EXCEL对象可见
End If
Err.Clear
Set xlBook = xlApp.Workbooks.Open(FileDir) '打开工件簿文件
xlBook.Visible = True
thisPath = ActiveWorkbook.Path & "\"
thisName = Range("a1")
Set xlSheet = xlBook.worksheets(1)
xlSheet.Range("A1:A12").Copy '''''''''''''''''''''''''这个貌似不执行啊

Windows("1.doc").Activate ''''''''''''''这个word含有表格，处于打开状态
Tables(1).Cell(1, 1).Select
Selection.HomeKey wdCell
Selection.MoveDown Unit:=wdLine, Count:=11, Extend:=wdExtend
Selection.Paste
xlApp.Quit
Set xlApp = Nothing
End Sub

还有问题可以再提

Answer 2

Range("A1:A12").Select
Selection.Copy'''''''''''''''''''''''''这个貌似不执行啊
Range("C1:C12").Select
ActiveSheet.Paste''''''''''''''''''这个也就不执行了

Windows("1.doc").Activate''''''''''''''这个word含有表格，处于打开状态
Selection.HomeKey wdStory
Selection.MoveDown Unit:=wdLine, Count:=11, Extend:=wdExtend
Selection.paste''''''''''''''''''''这个不知道有没有写错
上头这一段改成

Range("A1:A12").copy
Windows("1.doc").Activate
tables(1).cells(1,1).paste

这样应该可以了。