There are lots of code examples on my web site and elsewhere on the internet. Don't put buttons on your document - add a ribbon to your template http://gregmaxey.mvps.org/word_tip_p...bbon_main.html with the buttons. Don't clear the existing form. Create a new document from the template.
You could use a mapped content control to reproduce the number throughout the document. https://www.gmayor.com/insert_content_control_addin.htm should make the easy.
Here are a couple of macros to get you started. One simple. The other less so.
To print the current page:
Sub PrintPage()
Application.PrintOut Range:=wdPrintCurrentPage
lbl_Exit:
Exit Sub
End Sub
To e-mail the document
Sub SendDoc()
'Graham Mayor - http://www.gmayor.com - Last updated - 10/12/2016
Const strMsg As String = "Please find the enclosed document" 'the message body text
Const strRecipient As String = "someoneATsomewhere.com" 'the e-mail address of the intended recipient
Const strSubject As String = "Attached Form" 'the message subject
Dim sPath As String
sPath = Environ("TEMP") & "\Form Document.docx" 'the temporary filename
ActiveDocument.SaveAs2 FileName:=sPath, AddToRecentFiles:=False
Send_As_Mail strTo:=strRecipient, _
strSubject:=strSubject, _
strMessage:=strMsg, _
bSendAsAttachment:=True
ActiveDocument.Close 0
'create another document
'If MsgBox("Create another form?", vbYesNo) = vbYes Then
' Documents.Add Template:=ThisDocument.FullName
'End If
lbl_Exit:
Exit Sub
End Sub
Public Sub Send_As_Mail(strTo As String, _
strSubject As String, _
strMessage As String, _
Optional bSendAsAttachment As Boolean, _
Optional bPDFFormat As Boolean, _
Optional strAttachment As String)
'Graham Mayor - http://www.gmayor.com - Last updated - 10/12/2016
'bSendAsAttachment - Enter True/False - indicate whether to send the active document as an attachment
'Requires the code from - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to either retrieve an open instance of Outlook or open Outlook if it is closed.
Dim olApp As Object
Dim olInsp As Object
Dim oItem As Object
Dim wdDoc As Object
Dim oRng As Object
Dim bStarted As Boolean
Dim oDoc As Document
Dim strDocName As String
Dim strPath As String
Dim intPos As Integer
Dim iFormat As Long
Set oDoc = ActiveDocument
If Not bSendAsAttachment Then oDoc.Range.Copy
If bSendAsAttachment Then
'On Error GoTo Err_Handler
'Prompt the user to save the document
If bPDFFormat Then
strDocName = oDoc.Name
strPath = oDoc.Path & "\"
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
strDocName = strPath & strDocName & ".pdf"
oDoc.ExportAsFixedFormat OutputFilename:=strDocName, _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, From:=1, to:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
Else
strDocName = oDoc.FullName
End If
End If
Set olApp = OutlookApp()
'Create a new mailitem
Set oItem = olApp.CreateItem(0)
With oItem
.to = strTo
.Subject = strSubject
If bSendAsAttachment Then .Attachments.Add strDocName
If Not strAttachment = "" Then .Attachments.Add strAttachment
.BodyFormat = 2 'olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
oRng.Collapse 1
.Display
If bSendAsAttachment Then
oRng.Text = strMessage & vbCr
Else
oRng.Paste
End If
'.Send 'restore after testing
End With
If bStarted Then olApp.Quit
lbl_Exit:
Set oItem = Nothing
Set olApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oDoc = Nothing
Set oRng = Nothing
Exit Sub
err_Handler:
Err.Clear
GoTo lbl_Exit
End Sub
Reply With Quote
. Thanks. Some of that looks rather confusing but I'm sure it will be clearer to me once I've had time to go through it properly.