How do I print file properties with worksheet in excel ?

R

redd

I want to print file properties when I print out a worksheet.
I can't find a setting that allows me to do this.

I can do this in word though.
 
K

Kevin B

The following code inserts a new worksheet at the end of the current workbook
and prints the doc properties and their current values. The On Error Resume
Next is used because Excel does not have all of the built-in document
properties and and error occurs each time a property the Excel does not have
is encounterd.

As for the company and save time showing up more than once? Well I haven't
figured that one out yet.

Sub DocProps()

Dim wb As Workbook
Dim ws As Worksheet
Dim i As Integer
Dim l As Long
Dim p As DocumentProperty
Dim strProp As String
Set wb = ActiveWorkbook

On Error Resume Next

For Each ws In wb.Worksheets
i = i + 1
Next ws

wb.Worksheets.Add After:=Worksheets(i)

l = 1
Worksheets(i + 1).Activate
For Each p In ActiveWorkbook. _
BuiltinDocumentProperties
strProp = p.Name & ": " & p.Value
Cells(l, 1).Value = strProp
l = l + 1
Next

End Sub
 
K

Kevin B

Here's a cheesy work-around for repeating values:

Sub DocProps()

Dim wb As Workbook
Dim ws As Worksheet
Dim i As Integer
Dim l As Long
Dim p As DocumentProperty
Dim strProp As String
Dim intCompCount As Integer
Dim intSaveCount As Integer
Set wb = ActiveWorkbook

On Error Resume Next

For Each ws In wb.Worksheets
i = i + 1
Next ws

wb.Worksheets.Add After:=Worksheets(i)

l = 1
Worksheets(i + 1).Activate
For Each p In ActiveWorkbook. _
BuiltinDocumentProperties
strProp = p.Name
If strProp = "Last save time:" And intSaveCount = 0 Then
strProp = p.Name & ": " & p.Value
ElseIf strProp = "Company:" And intCompCount = 0 Then
strProp = p.Name & ": " & p.Value
Else
Cells(l, 1).Value = strProp
l = l + 1
End If
Next

End Sub
 
K

Kevin B

Please ignore the prior post with the cheesy work around, it did not work
correctly. Here's a correction that does work:

Dim wb As Workbook
Dim ws As Worksheet
Dim i As Integer
Dim l As Long
Dim p As DocumentProperty
Dim strProp As String
Dim intCompCount As Integer
Dim intSaveCount As Integer
Set wb = ActiveWorkbook

On Error Resume Next

Application.DisplayAlerts = False

For Each ws In wb.Worksheets
If ws.Name = "Doc Props" Then ws.Delete
Next ws
For Each ws In wb.Worksheets
i = i + 1
Next ws

wb.Worksheets.Add After:=Worksheets(i)
ActiveSheet.Name = "Doc Props"


l = 1
Worksheets(i + 1).Activate
For Each p In ActiveWorkbook. _
BuiltinDocumentProperties
strProp = p.Name
If strProp = "Last save time:" And intSaveCount = 0 Then
strProp = p.Name & ": " & p.Value
intSaveCount = intSaveCount + 1
ElseIf strProp = "Company:" And intCompCount = 0 Then
strProp = p.Name & ": " & p.Value
intCompCount = intCompCount + 1
Else
strProp = p.Name & ": " & p.Value
Cells(l, 1).Value = strProp
l = l + 1
End If
Next

End Sub
 
Top