[已解决]求个很有意思 的word的代码。。谢谢

excel小米

在word里写段代码，将选中的内容复制到指定的excel的A列。。。也就是达到鼠标选中内容后按下定义的快捷键（比如ctrl+shift+x)或者执行宏后直接把内容提取到excel列，excel可以为打开状态。。。谢谢大家了，

最佳答案

月排行榜 / 总排行榜

dsmch

2015-2-2 08:08

1. Sub Macro1()
   
2. On Error Resume Next
   
3. ww = Selection.Text
   
4. With GetObject("D:\2.xls")
   
5.     s = .Sheets(1).Range("a65536").End(xlUp).Row
   
6.     .Sheets(1).Cells(IIf(s = 1, 1, s + 1), 1) = ww
   
7.     Application.Windows(.Name).Visible = True
   
8. End With
   
9. End Sub

复制代码

跳转到最佳答案楼层

dsmch

这个没有意思啦，字、词、句、行、段落、节，想提取什么就提取。

excel小米

是的
ww = Selection.Text
    Dim projectno As String
    Dim excelobject As Object, wb As Object
    Set excelobject = CreateObject("excel.application") '启动Excel程序
    excelobject.Visible = True
    Set wb = excelobject.Workbooks.("D:\2.xls")
    On Error Resume Next
    wb.Sheets(1).Range("a" & wb.Sheets(1).Range("a65536").End(xlUp).Row + 1) = ww
End Sub

这个怎么都行不通啊
麻烦老师帮忙看看。。我的最终目的是为了在word里面写入这个宏然后指定给快捷键，然后直接输出到excel，这个excel是打开状态的，只是为了节省复制，切换到excel黏贴，再切换回word界面这么个时间。


谢谢老师了

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. ww = Selection.Text
   
4. Set exl = CreateObject("excel.application") '启动Excel程序
   
5. With exl.Workbooks.Open("D:\2.xls")
   
6.     .sheets(1).[a1] = ww
   
7.     .Close True
   
8. End With
   
9. exl.Quit
   
10. End Sub

复制代码

excel小米

dsmch 发表于 2015-2-1 15:00

老师，帮人帮到底，麻烦帮我看看，我这设定为excel文件已打开状态，应该怎么写 啊，，Open不要  Quit也省了。。。
谢谢您了

dsmch

1. Dim s&
   
2. Sub Macro1()
   
3. On Error Resume Next
   
4. ww = Selection.Text
   
5. s = s + 1
   
6. With GetObject("D:\2.xls")
   
7.     .sheets(1).Cells(s, 1) = ww
   
8.     Application.Windows(.Name).Visible = True
   
9. End With
   
10. End Sub

复制代码

excel小米

dsmch 发表于 2015-2-2 04:01

老师啊，现在实现这个功能了，，
不过我有个疑问，
为什么 这么写.sheets(1).Range(.sheets(1).Range("a" & .sheets(1).Range("a65536").End(xlup).Row + 1)) = ww
就直接没有返回结果了，因为s=s+1   .sheets(1).Cells(s, 1) = ww这样的话每次都会默认从A1开始，如果我我A1:A10已经有数据了，而且这些数据不能被替换掉的话，我想从A列最后单元格开始写入的话。。。。

再次麻烦您了。谢谢谢谢

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. ww = Selection.Text
   
4. With GetObject("D:\2.xls")
   
5.     s = .Sheets(1).Range("a65536").End(xlUp).Row
   
6.     .Sheets(1).Cells(IIf(s = 1, 1, s + 1), 1) = ww
   
7.     Application.Windows(.Name).Visible = True
   
8. End With
   
9. End Sub

复制代码

excel小米

dsmch 发表于 2015-2-2 08:08

为什么我测试了，怎么S怎么都无法获取excelA列的最后单元格呢，每次执行都将内容输出到A1.。。。奇了怪了。

dsmch

excel小米 发表于 2015-2-2 15:39
为什么我测试了，怎么S怎么都无法获取excelA列的最后单元格呢，每次执行都将内容输出到A1.。。。奇了怪了 ...

测试了，确实有问题，看来wordvba和excelvba还是有差别，对wordvba比较生疏，让高手帮你看看