Hi Graham,
Here's an alternative rendition - I pinched some of your code, plus some from an MSKB article.
This code goes in the document's template and solicits the Author's surname whenever a new document is created, or an existing
document without an "AuthorSurname" custom property is opened. On creation, responding to the first prompt results in the header
creation; ignoring the first prompt takes you to a second. Respond to the second and the property is created but not the header;
ignore it and you'll get the same prompt next time the document is opened. Setting a dummy value eliminates further prompting. The
same routine (SetResetAuthorSurname) allows the Surname to be reset, if need be. Since a custom document proerty is used, a
DOCPROPERTY field is also used to insert (and update) the Surname shown in the header.
Private Sub AutoNew()
' see:
http://support.microsoft.com/kb/212618/en-us
' **************************************************
' This SubRoutine passes the Custom Property Name,
' Value, and Property Type to the SetProp subroutine.
' **************************************************
' Set the custom property "MyCustomPropertyName" equal ' to "MyCustomValue".
' The msoPropertyTypeString constant specifies the type of property, and must be included.
Dim oCDP, oProp, CDPName, StrNm
With ActiveDocument
Set oCDP = .CustomDocumentProperties
CDPName = "AuthorSurname"
For Each oProp In oCDP
' If the Custom Property exists...
If oProp.Name = CDPName Then Exit Sub
Next oProp
StrNm = Trim(InputBox("Please add the Document Author's Surname", "Add Author Surname"))
If StrNm = "" Then
SetResetAuthorSurname
Exit Sub
End If
SetProp "AuthorSurname", StrNm, msoPropertyTypeString
MakeHeader
End With
End Sub
Private Sub AutoOpen()
AutoNew
End Sub
Sub SetResetAuthorSurname()
Dim StrNm
StrNm = Trim(InputBox("Please set or reset the Document Author's Surname", "Set/Reset Author Surname"))
If StrNm = "" Then Exit Sub
SetProp "AuthorSurname", StrNm, msoPropertyTypeString
End Sub
Sub SetProp(CDPName As String, CDPValue As Variant, Optional CDPType As Long)
' ***********************************************
' The SetProp routine checks to see if the Custom Document Property pre-exists. If it exists,
' it adds the new value. If it does not exist, it creates the new property and adds the new value.
' ***********************************************
' Make sure the optional argument CDPType is set. If it is missing, make it a string value.
Dim oCDP, oProp, msg
If IsMissing(CDPType) Then
CDPType = msoPropertyTypeString
End If
Set oCDP = ActiveDocument.CustomDocumentProperties
' Compare each custom document property to the property you want to create to see if it exists.
For Each oProp In oCDP
' If the Custom Property exists...
If oProp.Name = CDPName Then
With oProp
' ...the custom property Type you are setting must match the pre-existing custom property.
If .Type <> CDPType Then
msg = "The custom property types do not match."
msg = msg + " Custom property not set."
MsgBox msg
' End the routine.
Exit Sub
End If
.LinkToContent = False
' Set the new value.
.Value = CDPValue
End With
' A match was found, so exit the routine.
Exit Sub
End If
Next oProp
' No match was found. Create a new property and value.
oCDP.Add Name:=CDPName, Value:=CDPValue, Type:=CDPType, LinkToContent:=False
End Sub
Sub MakeHeader()
With ActiveDocument
'open the header
.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
With Selection
'set the format for the insertion
.EndKey Unit:=wdStory
.Font.Name = "Arial"
.Font.Bold = False
.Font.Italic = True
.Font.Size = "10"
.ParagraphFormat.Alignment = wdAlignParagraphRight
'insert the surname
.Fields.Add Range:=Selection.Range, Type:=wdFieldDocProperty, _
PreserveFormatting:=False, Text:="AuthorSurname"
'insert 'Page'
.TypeText " Page "
'insert a page number field
.Fields.Add Range:=Selection.Range, Type:=wdFieldPage
End With
'close the header
.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End With
End Sub
--
macropod
[MVP - Microsoft Word]
| I had thought of that - but decided for it nevertheless. Let's hope the OP's
| colleagues have sensible names
|
| --
| <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
| Graham Mayor - Word MVP
|
| My web site
www.gmayor.com
|
| <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
|
| macropod wrote:
| > Hi Graham
| >
| > I thought of a similar approach but decided against it when I
| > realised it wouldn't work for surnames that have two or more parts
| > separated by one or more spaces (eg St John or Van Der Winkel) or, in
| > the case of your macro, the author field has more than one given
| > name.
| >
| > Cheers
| >
| >
| > | >> You cannot extract bits of fields in directly Word so the only way
| >> would be to insert the information using an automacro. Save the
| >> following in the document template (NOT normal.dot) and when you
| >> create a new document from that template the author's surname and
| >> page number are entered in the header in 10 point arial - right
| >> aligned.
| >>
| >> If these document are to be created from normal.dot, rename the
| >> macro to (e.g.) Sub InsertSurname() and apply it via a toolbar
| >> button. You don't want headers in normal.dot as they upset some of
| >> that templates core functions e.g. creating labels.
| >>
| >>
| >> Sub AutoNew()
| >> Dim strAuthor As String
| >> Dim intPos As Integer
| >> 'Read the documents author property
| >> strAuthor =
| >> ActiveDocument.BuiltInDocumentProperties(wdPropertyAuthor) intPos =
| >> InStrRev(strAuthor, " ") 'extract the surname
| >> strAuthor = Right(strAuthor, intPos - 1)
| >> With ActiveDocument
| >> 'open the header
| >> .ActiveWindow.ActivePane.View.SeekView =
| >> wdSeekCurrentPageHeader With Selection
| >> 'set the format for the insertion
| >> .EndKey Unit:=wdStory
| >> .Font.Name = "Arial"
| >> .Font.Bold = False
| >> .Font.Italic = True
| >> .Font.Size = "10"
| >> .ParagraphFormat.Alignment = wdAlignParagraphRight
| >> 'insert the surname and 'Page'
| >> .TypeText strAuthor & " Page "
| >> 'insert a page number field
| >> .Fields.Add Range:=Selection.Range, Type:=wdFieldPage
| >> End With
| >> 'close the header
| >> .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
| >> End With
| >> End Sub
| >>
| >> See
http://www.gmayor.com/installing_macro.htm
| >>
| >>
| >> --
| >> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
| >> Graham Mayor - Word MVP
| >>
| >> My web site
www.gmayor.com
| >>
| >> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
| >>
| >> Jed wrote:
| >>> Hello,
| >>>
| >>> I have a template I'm creating which requires just the author's last
| >>> name followed by the page number right-aligned in a header.
| >>>
| >>> How can I have the template automatically input just the last name
| >>> in the header when a new document is created?
| >>>
| >>> Thanks in advance,
| >>> Jed
|
|
