人生就像蒲公英看似自由却身不由己
一、如何在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让excel和word自动另存为
excel vba代码：
Sub 工作簿备份（）
Dim s, f As String, sht As Worksheet
f = [a3]
If f = "" Then Exit Sub
Application.ScreenUpdating = False
Workbooks.Add (xlWBATWorksheet)
Sheets(1).Name = "临时"
For Each sht In ThisWorkbook.Sheets
With ActiveWorkbook
sht.Copy after:=.Sheets(.Sheets.Count)
End With
Next
Application.DisplayAlerts = False
Sheets（"临时"）.Delete
Sheets(1).Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
s = Application.Dialogs(5).Show(arg1:=f & ".xls")
If s = True Then
ActiveWorkbook.Close
MsgBox "备份完毕"
Else
MsgBox "没有备份"
End If
End Sub
三、如何用word vba,根据特定字符保存文件
Sub test()
Dim Doc As Document
On Error Resume Next
For i = 1 To ThisDocument.Paragraphs.Count
txt = ThisDocument.Paragraphs(i).Range.Text
z = Split(Split(txt， "【")（1）， "】"）（0）
If Err.Number = 0 Then rng = rng & i & " " Else Err.Clear
Next
z = Split(rng, " ")
z(UBound(z)) = ThisDocument.Paragraphs.Count + 1
On Error GoTo 0
For j = 0 To UBound(z) - 1
Set Doc = Documents.Add
Set rngParagraphs = ThisDocument.Range(Start:=ThisDocument.Paragraphs(z(j)).Range.Start, _
End:=ThisDocument.Paragraphs(z(j + 1) - 1).Range.End)
rngParagraphs.Select
Selection.Copy
Doc.Range.Paste
Doc.SaveAs "D:\" & Replace(ThisDocument.Paragraphs(z(j)).Range.Text, Chr(13), "") & ".Doc"
Doc.Close True
Next
End Sub
四、求：（vba操作代码）word接受对文档的所有修订后保存,谢谢
AcceptAll 方法接受某一文档或区域中的所有修订。
修订标记将被删除，修订将合并到文档中。expression.AcceptAllexpression 必需。
返回 Revision 对象的表达式。说明应用 AcceptAllRevisions 方法来接受文档中的所有修订。
示例本示例接受活动文档中的所有修订。If ActiveDocument.Revisions.Count >= 1 Then _ActiveDocument.Revisions.AcceptAll本示例接受所选内容中的所有修订。
Selection.Range.Revisions.AcceptAll。
五、用vba打开word模板并修改后保存
1、打开Word文件的 VBA编辑器，快捷键 Alt+F11，右击【ThisDocument】-》 【插入模块】； 用VBA代码设置Word自动保存的步骤 2、双击刚才插入的【模块1】，添加如下代码： Sub 自动备份（） Dim NewTime NewTime = Now + TimeValue(“00:05:10”) Dim myPath$, myName$ myPath = ActiveDocument.Path myName = Left$(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) ChangeFileOpenDirectory myPath ActiveDocument.SaveAs FileName:=myName & “_temp.doc”, ReadOnlyRecommended:=True ActiveDocument.SaveAs FileName:=myName & “.doc”, ReadOnlyRecommended:=False Application.OnTime NewTime， “自动备份” CreateObject(“Wscript.shell”).popup “备份成功，备份文件名为：” & myName & “_temp.doc”, 2， “提示！2秒后自动关闭！” End Sub 用VBA代码设置Word自动保存的步骤 用VBA代码设置Word自动保存的步骤 3、双击【ThisDocument】并在其中 添加如下代码： Private Sub Document_Open() Call 自动备份 End Sub 用VBA代码设置Word自动保存的步骤 4、默认自动备份时间为5min，如要调整请修改【模块1】中一句代码：如图中红框所示： 时间格式为：HH : mm : ss 用VBA代码设置Word自动保存的步骤 5、保存代码及文件，且关闭word并重新打开，重新打开点击【选项】-》 【启用此内容】，如图： 用VBA代码设置Word自动保存的步骤 6、默认备份文件名为：【原文件名_temp,Lee.doc】且为只读，提示对话框2s后自动关闭。
备份效果显示如下： 。
六、如何用word vba,根据特定字符保存文件
Sub test() Dim Doc As Document On Error Resume Next For i = 1 To ThisDocument.Paragraphs.Count txt = ThisDocument.Paragraphs(i).Range.Text z = Split(Split(txt， "【")（1）， "】"）（0） If Err.Number = 0 Then rng = rng & i & " " Else Err.Clear Next z = Split(rng, " ") z(UBound(z)) = ThisDocument.Paragraphs.Count + 1 On Error GoTo 0 For j = 0 To UBound(z) - 1 Set Doc = Documents.Add Set rngParagraphs = ThisDocument.Range(Start:=ThisDocument.Paragraphs(z(j)).Range.Start, _ End:=ThisDocument.Paragraphs(z(j + 1) - 1).Range.End) rngParagraphs.Select Selection.Copy Doc.Range.Paste Doc.SaveAs "D:\" & Replace(ThisDocument.Paragraphs(z(j)).Range.Text, Chr(13), "") & ".Doc" Doc.Close True NextEnd Sub。
转载请注明出处51数据库 » vbaword保存文档
