windows:office_macros
This is an old revision of the document!
Table of Contents
Microsoft Office Macros
Word
Increment and Save
Increment revN at the end of the filename of the current file and save it.
- IncrAndSave.vba
Sub IncrAndSave() ' ' Increment the revision number and save ' ' ActiveDocument.Name Dim myfilename, currentfilename, nstr, newno, x, y, z As String Dim a, b, c, n As Integer Dim rev As Boolean ' this strips the extension from the filename currentfilename = CreateObject("scripting.filesystemobject").getbasename(ActiveDocument.Name) Set Regexp = CreateObject("VBScript.RegExp") Regexp.Pattern = "[0-9]+$" Set Matches = Regexp.Execute(currentfilename) rev = False For Each Match In Matches rev = True n = Match nstr = Match Next If rev Then myfilename = Mid(currentfilename, 1, Len(currentfilename) - Len(nstr)) newno = n + 1 myfilename = ActiveDocument.Path & "\" & myfilename & newno ' MsgBox "Saving current file to " & myfilename Else myfilename = ActiveDocument.Path & "\" & currentfilename & " rev1" End If ActiveDocument.SaveAs filename:=myfilename, FileFormat:= _ wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _ :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _ :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _ SaveAsAOCELetter:=False End Sub
Save a copy-edited version to a pre-defined folder
- SaveCopyEdit.vba
Sub SaveCopyEdit() ' ' SaveCopyEdit Macro ' ' ' ActiveDocument.Name Dim myfilename As String myfilename = "D:\slack\rwanda\copy edit\" & CreateObject("scripting.filesystemobject").getbasename(ActiveDocument.Name) & " revDH.docx" ' MsgBox myfilename Application.StatusBar = "Saving to copy edit folder..." ActiveDocument.SaveAs filename:=myfilename, FileFormat:= _ wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _ :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _ :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _ SaveAsAOCELetter:=False ActiveDocument.SaveAs ActiveDocument.TrackRevisions = True ' ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions End Sub
windows/office_macros.1494862482.txt.gz · Last modified: 2019/11/07 17:58 (external edit)