Sub 另存为不含宏的文档()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim oDoc As Document
Set oDoc = Word.ActiveDocument
Dim oRng As Range
Set oRng = oDoc.Content
Dim sPath As String
'默认存储路径,当前用户桌面,注释掉的是当前文档路径
sPath = Environ("userprofile") & "\Desktop\" 'Word.ActiveDocument.Path & "\"
'处理文件名
Dim strDocName As String
strDocName =ActiveDocument.Paragraphs(1).Range.Text '包含一个回车符
strDocName = Replace(strDocName, Chr(13), "") 'chr(10)'删除句末回车符,没有trim空格
'采用复制内容到新文档的形式,避免将宏代码带到新文档
oRng.Select
oRng.Copy
Dim oDocTemp As Document
Set oDocTemp = Word.Documents.Add
With oDocTemp.Application.Selection
.Paste
End With
'Dim vrtSelectedItem As Variant
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogSaveAs)
With fDialog
.AllowMultiSelect = False
.Filters.Clear '不清空会造成多次添加
.Filters.Add "Word文件", "*.doc;*.docx;*.docm", 1
.InitialFileName = sPath '& strDocName 'Left(vrtSelectedItem, Len(vrtSelectedItem) - 5)
'返回值-1表示按下确认按钮。如果没有判断,那么无论点击哪个按钮,均会保存文件到磁盘。
If .Show = -1 Then
'Set oDocTemp = Application.Documents.Save(vrtSelectedItem, ReadOnly:=True)'vrtSelectedItem为空
'.Execute'execute是SaveAs对话框配套的保存命令,执行的是直接另存为操作,会把宏代码带到新文档。改为调用SaveAs2方法完成存储操作
'.SelectedItems.Item(1)是对话框文件名修改后的名字。SelectedItems(1)为null
oDocTemp.SaveAs2 filename:=.SelectedItems.Item(1), FileFormat:=wdFormatDocumentDefault
oDocTemp.Close False
End If
End With
Set fDialog = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
上面代码需要注意地方两点,也是浪费我很多时间的地方,一是如果采用标题之类作为文件名,因为包括了回车符(换行符)导致代码一直报错,需要先删掉才能保存成功。
第二点,微软官方文档SaveAs2例子的人机交互有点不是很友好,直接用InputBox让用户输入文件名(见中间注释掉的代码)。所以考虑用dialog弹出另存的对话框,由用户选择文件类型和修改文件名(默认默认为文件内容的第一行(标题),减少手工劳动),但又有新的问题,dialog的.execute命令会直接将当前文档另存为新文档,导致VBA宏代码等也跟着到新文档,徒增文件体积。而我希望不要把宏代码带到新文档,采用声明一个新的文档对象,并且把当前文档的内容复制过去的形式,再使用了SaveAs2方法另存为新生成的文档对象。
上面的代码很好的结合了两方的优点,解决了缺点,完美!上面的处理方法是原创,反正我没看到过类似的解决方案。文章来源:https://www.toymoban.com/news/detail-617528.html
中间注释掉对文件名处理部分,留给有需要的人参考。文章来源地址https://www.toymoban.com/news/detail-617528.html
'摘抄自微软官方文档的一个例子
Dim intPos As Integer
intPos = InStrRev(strDocName, ".")
'此处删除后缀名,后续另存为对话框中选择文件类型后再加上后缀名
If intPos = 0 Then
' 如果文档还未保存,问用户输入文件名
strDocName = InputBox("请输入要保存的文件名:")
Else
'删除原来的后缀名并添加新的后缀名
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".docx"
End If
到了这里,关于VBA操作WORD(六)另存为不含宏的文档的文章就介绍完了。如果您还想了解更多内容,请在右上角搜索TOY模板网以前的文章或继续浏览下面的相关文章,希望大家以后多多支持TOY模板网!