WD上怎么附excel表格

1.excel怎么用宏导到word中,再从word中导到另一个excle 搜狗问问

刚好做了一个类似的，仅供参考，加油！ Sub 宏1() Dim templateFileURl1 As String Dim templateFileURl2 As String Dim templateFileURl3 As String On Error Resume Next Set WdApp = GetObject(, "Word.Application") '取得对WORDAPPLICATION对象的引用 If Err.Number <> 0 Then '如果无法取得对该对象的引用 Err.Clear Set WdApp = CreateObject("Word.Application") '创建WORDAPPLICATION对象 WdApp.Visible = True '可见 End If WdApp.Options.PictureWrapType = wdWrapMergeInline '为嵌入式 On Error Resume Next Set ShApp1 = GetObject(, "Excel.Application") '取得对excelAPPLICATION对象的引用 If Err.Number <> 0 Then '如果无法取得对该对象的引用 Err.Clear Set ShApp1 = CreateObject("Excel.Application") '创建excelAPPLICATION对象 ShApp1.Visible = True '可见 End If On Error Resume Next Set ShApp3 = GetObject(, "Excel.Application") '取得对excelAPPLICATION对象的引用 If Err.Number <> 0 Then '如果无法取得对该对象的引用 Err.Clear Set ShApp3 = CreateObject("Excel.Application") '创建excelAPPLICATION对象 ShApp3.Visible = True '可见 End If templateFileURl1 = ThisWorkbook.Sheets("Sheet1").[b1] templateFileURl2 = ThisWorkbook.Sheets("Sheet1").[b2] templateFileURl3 = ThisWorkbook.Sheets("Sheet1").[b3] Set mysheet1 = ShApp1.Workbooks.Open(templateFileURl1) Set mysheet3 = ShApp3.Workbooks.Open(templateFileURl3) Set WdDoc = WdApp.Documents.Open(templateFileURl2) '打开同一路径下的WORD"模板" With WdDoc 'from excel to word .Bookmarks("Name").Range.Text = mysheet1.Sheets(1).[a12] .Bookmarks("Name1").Range.Text = mysheet1.Sheets(1).[a12] .Bookmarks("Tel").Range.Text = mysheet1.Sheets(1).[b12] .Bookmarks("Id").Range.Text = mysheet1.Sheets(1).[j12] .Bookmarks("ConfirmHospital").Range.Text = mysheet1.Sheets(1).[h10] 'from word to final excel mysheet3.Sheets(1).Range("B1").Value = mysheet1.Sheets(1).[a12] mysheet3.Sheets(1).Range("B2").Value = mysheet1.Sheets(1).[a12] mysheet3.Sheets(1).Range("B3").Value = mysheet1.Sheets(1).[b12] mysheet3.Sheets(1).Range("B4").Value = mysheet1.Sheets(1).[j12] mysheet3.Sheets(1).Range("B5").Value = mysheet1.Sheets(1).[h10] End With 'WdDoc.SaveAs Filename:="d：\财务分析\" & name2 & name1 & ".doc" Set WdDoc = Nothing '释放对象变量 Set WdApp = Nothing '释放对象变量 Set mysheet1 = Nothing '释放对象变量 Set mysheet3 = Nothing '释放对象变量 Set ShApp1 = Nothing '释放对象变量 Set ShApp3 = Nothing '释放对象变量 End Sub。

2.如何利用宏把word文档中含有某些特定词的句子导入到excel表中

Sub FindWordCopySentence()'On Error Resume Next Dim intRowCount As Integer intRowCount = 1 Dim strMy(8) As String '加这些 Dim i As Integer strMy(1) = "should" strMy(2) = "objSheet"'内容自己换 strMy(3) = "Find" For i = 1 To 3 Call FoundMy(strMy(i), i) Next i'Dim appExcel As Object'Dim objSheet As Object'Dim aRange As Range'Set aRange = ActiveDocument.Range' With aRange.Find' Do' .Text = "should" 'the word I am looking for' .Execute' If .Found Then' aRange.Expand Unit:=wdSentence' aRange.Copy' aRange.Collapse wdCollapseEnd'' If objSheet Is Nothing Then'' Set appExcel = CreateObject("Excel.Application") 'Change the file path to match the location of your test.xls' Set objSheet = appExcel.workbooks.Open("D:\abcabc.xls").Sheets("Sheet1")' intRowCount = 1' End If' objSheet.Cells(intRowCount, 1).Select' objSheet.Paste' intRowCount = intRowCount + 1' End If' Loop While .Found' End With'If Not objSheet Is Nothing Then'appExcel.workbooks(1).Close True'appExcel.Quit'Set objSheet = Nothing'Set appExcel = Nothing'End If'Set aRange = Nothing MsgBox "完成" End Sub Private Sub FoundMy(strFound As String, intRow As Integer) '加这过程。

实际是你的那个宏。不同内容存入不同列 Dim appExcel As Object Dim objSheet As Object Dim aRange As Range Set aRange = ActiveDocument.Range With aRange.Find Do .Text = strFound 'the word I am looking for .Execute If .Found Then aRange.Expand Unit:=wdSentence aRange.Copy aRange.Collapse wdCollapseEnd If objSheet Is Nothing Then Set appExcel = CreateObject("Excel.Application") 'Change the file path to match the location of your test.xls Set objSheet = appExcel.workbooks.Open("D:\abcabc.xls").Sheets("Sheet1") intRowCount = 1 End If objSheet.Cells(intRowCount, intRow).Select objSheet.Paste intRowCount = intRowCount + 1 End If Loop While .Found End With If Not objSheet Is Nothing Then appExcel.workbooks(1).Close True appExcel.Quit Set objSheet = Nothing Set appExcel = Nothing End If Set aRange = Nothing End Sub 因为俺对 对象的操作不内行，所以效率可能不高。

希望高手能完善它。