作者:乔山办公网日期:
返回目录:excel表格制作
'打开后焦点发生了转移,activedocument已经指向刚打开的文件了
'改为
Sub Macro1()
Dim myDoc
'On Error Resume Next
With ActiveDocument.Tables(1).Cell(Row:=1, Column:=3).Range
Set myDoc = Word.Application.Documents.Open("E:\1.docx")
.Delete
.InsertAfter Text:=myDoc.Tables(2).Cell(Row:=1, Column:=2)
End With
End Sub
'(
InsertAfter Text:=myDoc.Tables(2).Cell(Row:=1, Column:=2)这行代码中,你确定表2存在吗?我测试时只建一个表,所以改为Tables(1).
)
'也可以这样控制焦点
Sub Macro1()
Dim myDoc
'On Error Resume Next
Set myDoc = Word.Application.Documents.Open("E:\1.docx", , , , , , , , , , , vbHide)
With ActiveDocument.Tables(1).Cell(Row:=1, Column:=3).Range
.Delete
.InsertAfter Text:=myDoc.Tables(2).Cell(Row:=1, Column:=2)
End With
End Sub
'至于为什么多出一个换e799bee5baa6e59b9ee7ad94363行符我还没想明白
试试下面的代码:
Sub 宏1()
Dim wordapp As Object
Dim mydoc
Dim mypath$, myname$
Dim wdRng As Object
Dim pos1%, pos2% '定义找到的字段7a64e59b9ee7ad94338的首位位置
Application.DisplayAlerts = False
Set wordapp = CreateObject("word.application")
mypath = ThisWorkbook.Path & ""
myname = Dir(mypath & "*.doc*")
Set mydoc = wordapp.Documents.Open(mypath & myname)
Set wdRng = mydoc.Range
wdRng.Find.Execute ("(一)")
pos1 = wdRng.Start
Set wdRng = mydoc.Range
wdRng.Find.Execute ("五、")
pos2 = wdRng.Start
mydoc.Range(pos1, pos2).Copy '选中找到的两个字段中间的内容
mydoc.Close False
wordapp.Quit
Worksheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
试试下面的代码,在网上找的
Sub 宏1()
Dim wordapp As Object
Dim mydoc
Dim mypath$, myname$
Dim wdRng As Object
Dim pos1%, pos2% '定义找到的e68a84e8a2ade799bee5baa6e79fa5e98193361字段的首位位置
Application.DisplayAlerts = False
Set wordapp = CreateObject("word.application")
mypath = ThisWorkbook.Path & ""
myname = Dir(mypath & "*.doc*")
Set mydoc = wordapp.Documents.Open(mypath & myname)
Set wdRng = mydoc.Range
wdRng.Find.Execute ("(一)")
pos1 = wdRng.Start
Set wdRng = mydoc.Range
wdRng.Find.Execute ("五、")
pos2 = wdRng.Start
mydoc.Range(pos1, pos2).Copy '选中找到的两个字段中间的内容
mydoc.Close False
wordapp.Quit
Worksheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub