08-04 2017
深宫劫美婢难宠
Sub 存成html()Application.ScreenUpdating = False Dim FileName As String FileName = InputBox("请输入文件名") Selection.Copy Documents.Add DocumentType:=wdNewBlankDocument Selection.PasteAndFormat (wdPasteDefault) '若无目录则创建 If Dir("D:\backup0591\桌面\报告temp\", vbDirectory) = "" Then MkDir "D:\backup0591\桌面\报告temp\" ActiveDocument.SaveAs FileName:="D:\backup0591\桌面\报告temp\" & FileName, FileFormat:=wdFormatHTML, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ False ActiveWindow.View.Type = wdWebView '段与段顶多只隔一行,将任意个回车符号替换成二个 With Selection.Find .Text = "(^13)@" .Replacement.Text = "^p^p" .Forward = True .Wrap = wdFindContinue .MatchByte = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll '全选+剪切 Selection.WholeStory Selection.Cut ActiveDocument.Close FalseApplication.ScreenUpdating = TrueMsgBox "已完成!"End Sub