How do I code authorship into a footer?

M

mkblue

I would like the author's initials to appear in a footer. How do I add a
code so that when the user changes, it automatically changes the footer?
 
S

Steve Yandl

Here is one option that might work for you

__________________________

Private Sub Workbook_Open()

Set objWord = CreateObject("Word.Application")
strInitials = objWord.UserInitials
objWord.Quit
Set objWord = Nothing

For Each objWksheet In ThisWorkbook.Worksheets
objWksheet.PageSetup.LeftFooter = strInitials
Next objWksheet

End Sub

__________________________

Steve
 
G

Gord Dibben

The author and user could be two separate entities.

The author is the person whose name appears on File>Properties>Summary.

The user would be whoever has the workbook open.

Either or both would have to be done through code.

For the author...................

'=DOCPROPS("author")
'or
'=DOCPROPS("last save time")
'or
'DOCPROPS("creation date")

Function DocProps(prop As String)
Application.Volatile
On Error GoTo err_value
DocProps = ActiveWorkbook.BuiltinDocumentProperties _
(prop)
Exit Function
err_value:
DocProps = CVErr(xlErrValue)
End Function

Then let this BeforePrint code run which will give both author and username if
different.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Application.UserName <> DocProps("author") Then
ActiveSheet.PageSetup.RightFooter = ActiveWorkbook.FullName & " " & _
ActiveSheet.Name & " User " & Application.UserName & " " & Date _
& " Author " & DocProps("author")
Else: ActiveSheet.PageSetup.RightFooter = ActiveWorkbook.FullName & " " _
& ActiveSheet.Name & " User " & Application.UserName & " " & Date
End If
End Sub

Edit out the properties you don't want included.

I don't know how to get the author's initials without some more work


Gord Dibben MS Excel MVP
 
S

Steve Yandl

Gord,

Something like:

Sub UserInitials()
Dim strInitials As String

arrFullName = Split(Application.UserName)
For N = 0 To UBound(arrFullName)
strInitials = strInitials & Left(arrFullName(N), 1)
Next N

MsgBox strInitials

End Sub

could be integrated with your code to return initials whether looking at the
author or the current user. I just assumed the OP wanted the current user
even though they did use the term author as well. I looked at an expanded
version of what I have above but in my case, it returns SY because I set up
my system using just first and last name but when asked for initials I
generally include my middle initial, SJY. The Word object can quickly
produce the user's initials as they prefer them although I suspect it isn't
the most efficient way to do things from Excel.

Steve
 
G

Gord Dibben

Right-click on the Excel logo left of "File" on menu bar or at left side of
window Title bar if not maximized.

Select "View Code"

Paste this into the Thisworkbook module that opens.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
ActiveSheet.PageSetup.RightFooter = ActiveWorkbook.FullName & " " & _
ActiveSheet.Name & " " & Environ("UserName") & " " & Date
End Sub

Edit out any bits you don't want. Stripped down to just Username would be

Private Sub Workbook_BeforePrint(Cancel As Boolean)
ActiveSheet.PageSetup.RightFooter = Environ("UserName")
End Sub

Note: you could change to LeftFooter or CenterFooter

Alt + q to go back to your Excel Window.

Save the workbook.


Gord Dibben MS Excel MVP
 
Top