vbaword保存文档

一、如何在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保存文档