word中怎么批量插入excel表格
word2007一般有三种方法:
1、表格复制过来。右击excel表格左上角的空白单元格,复制。打开word文档,右击粘贴,单击表格右下方图标选择粘贴方式比如“仅保留文字”,按自己的需要选择即可。
2、上面是复制制作好的表格,如果插入新表格可以:插入---表格---excel电子表格。excel表格就插入进去了。
3、由对象插入。插入----对象-----对象-----新建------对象类型------选择excel表格(有几种)----确定。
word表格如何批量转换为excel表格
具体方法如下:
1、打开有需要转换工作表的word文档,将鼠标光标移到表格中任意一格。
2、点击表格右下角的“口”字形,就选中了整个表格。
3、然后在表格中任意位置右键单击,在快捷菜单中选择“复制”。
4、打开excel文档,然后在单元上右键单击,在快捷菜单中选择“选择性粘贴”。
5、在“选择性粘贴”对话框中,粘贴方式选择“文本”。
6、然后点击“确定”,就得到如下图的表格。
如何将excel表格批量导入word表格
用vba编制程序来实现。
第一步:创建一个对照表,将excel表格的开始行号、结束行号、开始列号、结束列号以及word文档中表格的序号、开始行号、开始列号输入到对照表。 第二步:编制vba程序,读取对照表信息,根据对照表要求读取excel表格数据,写入到word的对应表格中。
下面是我曾经做过的例子,截取部分对照表信息以及部分程序代码供参考。 1、对照表截图 2、部分程序源码 Sub 导出数据()S_EXCEL = Cells(4, 3).Text '数据源EXCEL文件名T_WORD = Cells(7, 3).Text '目标WORD文档名DZB = Cells(5, 3).Text '对照表工作表名Call exc_to_word(S_EXCEL, T_WORD, DZB)End SubSub exc_to_word(S_EXCEL, T_WORD, DZB)Dim wdoc As New Word.ApplicationDim myPath As StringDim XLAPP, MYSDim toolsB '工具工作簿Dim I, J, K, L As IntegerDim tableName As StringDim exc_beginLine As IntegerDim exc_endLine As IntegerDim exc_beginColumn As IntegerDim exc_endColumn As IntegerDim wod_tableNumber As IntegerDim wod_beginLine As IntegerDim wod_beginColumn As IntegerDim dataArr(1 To 500, 1 To 10)Dim myDs '需要写入数据的WORD数据表Dim XM(1 To 100) '存放表格的项目名称'myPath = "G:\EXCEL学习\猪八戒任务\EXCEL-TO-WORD\20151214\"toolsB = ThisWorkbook.Name '保存当前工作簿名称Windows(S_EXCEL).ActivateSet WB = ActiveWorkbook '数据源工作簿Windows(toolsB).ActivateSet MYS = ActiveWorkbook.Sheets(DZB)导出路径文件名 = ThisWorkbook.Path & "\" & T_WORD & ".docx"Set MYDOC = wdoc.Documents.Open(导出路径文件名)wdoc.Visible = TrueI = 2Do While MYS.Cells(I, 1) > 0 tableName = MYS.Cells(I, 2) exc_beginLine = MYS.Cells(I, 3) exc_endLine = MYS.Cells(I, 9) exc_beginColumn = MYS.Cells(I, 4) exc_endColumn = MYS.Cells(I, 5) wod_tableNumber = MYS.Cells(I, 6) wod_beginLine = MYS.Cells(I, 7) wod_beginColumn = MYS.Cells(I, 8) WOD_FILENAME = MYS.Cells(I, 10) If WOD_FILENAME = T_WORD Then Set mYs2 = WB.Worksheets(tableName) For J = 1 To exc_endLine - exc_beginLine + 1 XM(J) = mYs2.Cells(J + exc_beginLine - 1, 1) For K = 1 To exc_endColumn - exc_beginColumn + 1 dataArr(J, K) = mYs2.Cells(J + exc_beginLine - 1, K + exc_beginColumn - 1) Next K Next J Set myDs = MYDOC.Tables(wod_tableNumber) L = myDs.Rows.Count '读取WORD表格行数 ' If L - wod_beginLine + 1 < exc_endline="" -="" exc_beginline="" +="" 1="" then="" '="" word表格插入行,使其同excel表格行数相同="" 一次插入多行没搞明白,故用此循环="" do="" while="" l="" -="" wod_beginline="" +="" 1="">< exc_endline="" -="" exc_beginline="" +="" 1="" 'set="" mytable="ActiveDocument.Tables(1)" 'set="" newrow="myTable.Rows.Add(BeforeRow:=myTable.Rows(1))" 'set="" mylastrow="myDs.Rows.Last" -="" 1="" '从倒数第二行开始插入,以保持word格式的一致="" 走不通!="" set="" mylastrow="myDs.Rows.Last" myds.rows.add="" mylastrow="" l="myDs.Rows.Count" '读取word表格行数="" loop="" '="" myds.rows.add="" (exc_endline="" -="" exc_beginline="" +="" 1)="" -="" (l="" -="" wod_beginline="" +="" 1)="" '="" myds.cell(row:="L" -="" wod_beginline="" +="" 1,="" column:="wod_beginColumn).Select" '="" selection.insertrowsbelow="" (exc_endline="" -="" exc_beginline="" +="" 1)="" -="" (l="" -="" wod_beginline="" +="" 1)="" for="" j="1" to="" exc_endline="" -="" exc_beginline="" +="" 1="" myds.cell(row:="wod_beginLine" +="" j="" -="" 1,="" column:="1).Range" =="" xm(j)="" next="" j="" '="" end="" if="" for="" j="1" to="" exc_endline="" -="" exc_beginline="" +="" 1="" for="" k="1" to="" exc_endcolumn="" -="" exc_begincolumn="" +="" 1="" if="" not="" iserror(dataarr(j,="" k))="" then="" myds.cell(row:="wod_beginLine" +="" j="" -="" 1,="" column:="wod_beginColumn" +="" k="" -="" 1).range.text="VBA.Format$(dataArr(J," k),="" "#,###.00")="" end="" if="" next="" k="" next="" j="" end="" if="" i="I" +="" 1loopmydoc.savemydoc.close="" false="" '关闭word文档set="" mydoc="Nothing" '清空工作簿项目end="">
怎么vba实现word表格批量转为excel
注:vba偶并不太熟(偶一般是用c#和delphi的),VBA只是稍有了解,以下代码大部分是偶google到的内容拼出来的。
如下,使用时先更改test下的docpath和xlspath路径设定,docpath即你的word的目录,此目录包括子目录下的所有doc将被读取,xlspath即输出目录,需要存在 在VBA窗口中,先在视图下显示立即窗口以观察进度,程序最后的输出类似这样 正在读取[1]:->D:\1\Resume.doc 正在生成:->d:\2\Resume 正在读取[2]:->D:\1\简历(简).doc 正在生成:->d:\2\简历(简) 正在读取[3]:->D:\1\计数器说明.doc 正在生成:->d:\2\计数器说明 共耗时0分41秒 Option Explicit Dim docpath As String, xlspath As String'ResultFlag=0 获取路径'ResultFlag=1 获取文件名'ResultFlag=2 获取扩展名 Public Function SplitPath(FullPath As String, ResultFlag As Integer) As String Dim SplitPos As Integer, DotPos As Integer SplitPos = InStrRev(FullPath, "\") DotPos = InStrRev(FullPath, ".") Select Case ResultFlag Case 0 SplitPath = Left(FullPath, SplitPos - 1) Case 1 If DotPos = 0 Then DotPos = Len(FullPath) + 1 SplitPath = Mid(FullPath, SplitPos + 1, DotPos - SplitPos - 1) Case 2 If DotPos = 0 Then DotPos = Len(FullPath) SplitPath = Mid(FullPath, DotPos + 1) Case Else Err.Raise vbObjectError + 1, "SplitPath Function", "Invalid Parameter!" End Select End Function Public Function FileFolderExists(ByVal strFullPath As String) As Boolean On Error GoTo EarlyExit If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True EarlyExit: On Error GoTo 0 End Function Sub Test() '使用双字典,旨在提高速度 Dim MyName, Dic, Did, I, T, F, TT, MyFileName, Doc, Ke Dim count As Integer count = 0 T = Time docpath = "D:\1\" xlspath = "d:\2\" Set Dic = CreateObject("Scripting.Dictionary") '创建一个字典对象 Set Did = CreateObject("Scripting.Dictionary") Dic.Add (docpath), "" I = 0 Do While I < dic.count="" ke="Dic.keys" '开始遍历字典="" myname="Dir(Ke(I)," vbdirectory)="" '查找目录="" do="" while="" myname=""><> "" If MyName <> "." And MyName <> ".." Then If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then '如果是次级目录 Dic.Add (Ke(I) & MyName & "\"), "" '就往字典中添加这个次级目录名作为一个条目 End If End If MyName = Dir '继续遍历寻找 Loop I = I + 1 Loop 'Did.Add ("文件清单"), "" '以查找D盘下所有EXCEL文件为例 For Each Ke In Dic.keys MyFileName = Dir(Ke & "*.doc") Do While MyFileName <> "" Doc = Ke & MyFileName Did.Add (Doc), "" count = count + 1 Debug.Print "正在读取[" & count & "]:->" & Doc doc2xls (Doc) MyFileName = Dir Loop Next ' For Each Sh In ThisWorkbook.Worksheets ' If Sh.Name = "XLS文件清单" Then ' Sheets("XLS文件清单").Cells.Delete ' F = True ' Exit For ' Else ' F = False ' End If ' Next 'If Not F Then ' Sheets.Add.Name = "XLS文件清单" 'End If 'Sheets("XLS文件清单").[A1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys) TT = Time - T Debug.Print "共耗时" & Minute(TT) & "分" & Second(TT) & "秒" End Sub Sub doc2xls(filename As String) Dim xlApp As Object, xlSheet As Object, outfile As String, c As Object Set xlApp = CreateObject("Excel.Application") Set xlSheet = xlApp.Workbooks.Add.Sheets(1) Dim Wapp As Object, Doc As Object, GetDocText As Object 'Word Application 对象、Document 对象 Set Wapp = CreateObject("Word.Application") '创建Word Application 对象 Set Doc = Wapp.Documents.Open(filename, ReadOnly:=True) '打开文档,返回一个文档对象'xlSheet.Range("A1") = Doc.Content.Text Doc.Application.Selection.WholeStory ''''全选 Doc.Application.Selection.Copy ''''''''''复制 xlSheet.Range("A1").Select xlSheet.Paste outfile = xlspath + Replace(SplitPath(filename, 1), ".doc", ".xls") Debug.Print "正在生成:->" & outfile xlSheet.Parent.SaveAs outfile xlApp.Quit Set xlSheet = Nothing Set xlApp = Nothing Wapp.Quit Set Doc = Nothing Set Wapp = Nothing End Sub。
请问如何将多个word表格里的内容批量提取到一张excel表中? 问
Sub 自动把word表格转换到Excel()
On Error Resume Next ''''''出错继续(应对不规范的表格)
''''''重命名所有WORD文件为大写“A”。如 A (1).docx。
''maxcolumn(xex)
Dim maxrowend2
Dim wdApp
For w3 = 1 To 2 想合并多少个文档?
maxrowend2 = Sheets("sheet1").[a65536].End(xlUp).Row
Set wdApp = CreateObject("word.application")
path_ = ThisWorkbook.Path
wdApp.Documents.Open (path_ & "\" & "A (" & w3 & ")" & ".docx")
wdApp.Visible = True
n = wdApp.ActiveDocument.Tables.Count ''''有多少个表格
'x = 0
x = maxrowend2 + 1 ''''初始行号
y = 0
For i = 1 To n
rs = wdApp.ActiveDocument.Tables(i).Rows.Count ''''有多少个行
cs = wdApp.ActiveDocument.Tables(i).Columns.Count ''''有多少个列
''''''ghg = MsgBox(rs & "行列" & cs) '''''''''''''''''''''''''''''''提示
For m = 1 To rs
x = x + 1
y = 1
ThisWorkbook.Sheets("Sheet1").Cells(x, 1) = "源自A (" & w3 & ")" & ".docx" & "; 第" & i & " 表 " ''''''''''9999999999999999999
For n = 1 To cs
vv = wdApp.ActiveDocument.Tables(i).Cell(m, n)
ThisWorkbook.Sheets("Sheet1").Cells(x, y + 1) = Mid(vv, 1, Len(vv) - 1) '''空第一列
y = y + 1
Next
Next
Next
wdApp.Application.Quit '关闭word文档
Set wdApp = Nothing '释放对象变量的内存
Next
End Sub
转载请注明出处51数据库 » word批量excel图表