摘要：如何在EXECL中用VBa打开Word,并输出数据到WORD中,保存,关 在EXcel的VB编辑器中插入一个模块，输入如下代码试试看。 Sub ExcelToWord() Dim WordObje...

如何在EXECL中用VBa打开Word,并输出数据到WORD中,保存,关...

在EXcel的VB编辑器中插入一个模块，输入如下代码试试看。

Sub ExcelToWord() Dim WordObject As Object "声明一个对象变量，这里即将声明为Word对象 On Error Resume Next Set WordObject = CreateObject(＂Word.Application＂) "用set来创建Word对象，这里是运行Word程序，但未新建文档 WordObject.Visible = 0 "后台运行Word对象，只在任务管理器中存在WinWord.exe进程，但在任务栏上看不到word；如果为1或者True则可以看到word运行界面 WordObject.Documents.Add DocumentType:=wdNewBlankDocument "新建一word文档 "以下为获取Excel表格中的内容，准备把数据传送给Word，可以根据自己的实际需要定制代码，这里只是示例代码 Excel.Application.Sheets(1).Activate "切换当前电子表格的表1为当前激活表 Excel.Application.Sheets(1).UsedRange.Select "选中当前激活表的所有数据 Selection.Copy "将选中的区域进行复制 WordObject.Application.Activate "将后台运行的Word激活为当前窗口 WordObject.ActiveWindow.Selection.Paste "将刚才从Excel中复制进剪贴板中的内容粘贴进word中来 WordObject.Saved = True "将保存文档的Saved属性设置为True，这样后台运行的Word在保存文档时就不会弹出是否保存的对话框了，达到悄无声息的效果 WordObject.ActiveDocument.SaveAs ＂D:\temp\导出数据.doc＂ "调用saveas命令保存文档，根据实际，指定文档的保存路径和名称 WordObject.Application.Quit "退出并关闭程序文档 Set WordObject = Nothing "释放对象End Sub...

用vba打开word模板并修改后保存

你的问题我最近也有碰到，找不到人帮我，我找出了一套解决的方法....方法很简单，不需要使用shell函数，剪贴簿或是api也可以解决，要将 access 中的变数传到 word中，有两种方法（可能有很多吧！！但是我只知道这两种），第一是利用word内建的合并列印功能，另外一种是使用word中的＂插入（i）/功能变数（F）＂然后利用一个＂DocVariable＂功能变数，这样就可以轻松在VBA中对word文件中的指定的位置加入经程式处理过的文字....当然这两种方法，都需要程式设计者先设计一个word文件，使这个word文件一开启就具有已有己经事先安排好的合并列印栏位或是变数，让使用者只要在access中按下一个commandbutton就可以顺利看到自己所需的报表或是你所说的考卷出现在word中....我就access 的部份做说明....我是先设计一个整体资料库（数据库）共用的公用程式模组，记得要引用Microsoft Word Object Library 10.0物件 程式中需要用到时才呼叫....程式码如下：{ Option Compare Database"此数据库必需先引用Microsoft Word Object Library 10.0 Public wdapp As Word.Application "宣告一个新的word应用程式物件 Public Sub openwddoc(filename As String, name2 As String)"本程序使用word开启已存在之word文件（.doc或.dot档案），并自动另存一份新档，让使用者不致修改到原始word文件档"filename引数（指定欲开启档案的绝对路径），name2引数（开启档案后另存新档的绝对路径）"注意！！！！如果另存新档的路径下有同档名的文件，word将不会提示而直接覆盖掉 wdapp.Visible = True wdapp.Documents.Open filename, , ReadOnly "加入ReadOnly以防程式出错时，导致使用者可以修改原始Word档，让连结功能失效 wdapp.ActiveDocument.SaveAs name2 "让word 自动另存新档到name2所指定的路径及档名 End Sub Public Sub unloadwdapp（) "卸载word应用程式的工具程序，每个呼叫word的sub最好都执行一次这个sub一次，否则容易造成系统执行很多次winword.exe导致记忆体不足 wdapp.Quit End Sub Public Sub sendvar(sourcevar As String, objectvar As String)"本函数将access中欲传送的变数，传送至己存在的word文件中的指定变数"sourcevar引数，access 中欲传至word的任意变数"objectvar引数，位於word中Docvariable的变数名称 wdapp.ActiveDocument.Variables(objectvar) = sourcevar"使word文件变数=access变数 End Sub } public sub cutlink() wdapp.ActiveDocument.Fields.Update"更新功能变数 wdapp.ActiveDocument.Fields.Unlink"中断连结 end sub 建立完以上的四个共用程序后，在窗体程式码部份，其实只要使用call指令来依顺序呼叫就可以了，比如：{ Private Sub Command2_Click() Dim name1 As String Dim name2 As String name1 = CurrentProject.Path & ＂\1.doc＂ name2 = CurrentProject.Path & ＂\2.doc＂ Set wdapp = CreateObject(＂word.application＂) "这一行一定要加入，否则程式会出错 Call openwddoc(name1, name2) Call sendvar(Text0.Value, ＂var1＂) "var1是我在1.doc之中预先设下的文件变数，在这里要加上引号，才能使用，不然会被VBA当成一个变数名称，值也会变成null Call cutlink End Sub } 这是传递资料的其中一种方法，只适合用在单一笔记录资料传递时使用，如果资料笔数很多，建议你使用合并列印的功能 将合并列印的资料来源指向目前数据库中的一个Query，并将你的资料表（table）加上一个＂yes/no＂的栏位，要印出来的就打勾 把query之中的查询准则设为＂yes＂，这样就可以只列出你所需要的笔数，之后再呼叫上方的openwddoc（)程序，开启你已设计好的word文件 就可以了...希望对你有帮助，有问题大家一起讨论....

如何用vb在word中输出文字

方法很简单，不需要使用shell函数，剪贴簿或是api也可以解决，要将 access 中的变数传到 word中，有两种方法（可能有很多吧！！但是我只知道这两种），第一是利用word内建的合并列印功能，另外一种是使用word中的＂插入（i）/功能变数（F）＂然后利用一个＂DocVariable＂功能变数，这样就可以轻松在VBA中对word文件中的指定的位置加入经程式处理过的文字....当然这两种方法，都需要程式设计者先设计一个word文件，使这个word文件一开启就具有已有己经事先安排好的合并列印栏位或是变数，让使用者只要在access中按下一个commandbutton就可以顺利看到自己所需的报表或是你所说的考卷出现在word中....

操作一软件,Microsoft Excel导出数据时,屏幕显示“Microsoft Office...

注：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 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 vba中强制保留小数,如199保留为199.00

方法一：做一个代码块，供主程序调用。

例如：Sub w(a As String) If Right(a, 3) ＂.＂ ThenActiveDocument.Range.InsertAfter (a & ＂.00＂)"此句改为你实际要放数字的地方End If End Sub"调用时，要带参数，参数a 你计算出来的结果 [张志晨注] 如：w 123输出为123.00 我已测试，绝对可用！方法二：使用格式化语句：format(numer,＂#.00＂) numer 为你计算出来的数字。

方法三：如果需要Hi Me========================================您的问题==我的课题 奉献知识==辉煌生命黑龙江省 张志晨========================================