Visio – Revision Dates per Page

One of the posters in the newsgroup was asking about providing a revision date on each page of a Visio document and this is what I came up with. The only dates that are associated with a Visio drawing are done at the document level, so another approach is necessary.

To create a date stamp at the page level, add a custom property/Shape Data to the pagesheet for each page. This property can then be changed automatically when the page is altered. Since the property is updated automatically, the property will also be created if it does not exist.

Private Sub Document_BeforeSelectionDelete(ByVal Selection As IVSelection)
UpdateDateReviewed
End Sub

Private Sub Document_PageAdded(ByVal Page As IVPage) UpdateDateReviewed
End Sub

Private Sub Document_ShapeAdded(ByVal Shape As IVShape)
UpdateDateReviewed
End Sub

Private Sub Document_ShapeExitedTextEdit(ByVal Shape As IVShape)
UpdateDateReviewed
End Sub

Sub UpdateDateReviewed()
Dim vsoShape As Visio.Shape
Dim intPropRow As Integer

Set vsoShape = ActivePage.PageSheet

If vsoShape.CellExists("Prop.DateRevised", False) = False Then
intPropRow = vsoShape.AddRow(visSectionProp, visRowLast, visTagDefault)
vsoShape.CellsSRC(visSectionProp, intPropRow, visCustPropsLabel).FormulaU = """DateRevised"""
vsoShape.CellsSRC(visSectionProp, intPropRow, visCustPropsValue).RowNameU = "DateRevised"
vsoShape.CellsSRC(visSectionProp, intPropRow, visCustPropsType).FormulaU = "5"
vsoShape.CellsSRC(visSectionProp, intPropRow, visCustPropsFormat).FormulaU = ""
vsoShape.CellsSRC(visSectionProp, intPropRow, visCustPropsPrompt).FormulaU = ""
vsoShape.CellsSRC(visSectionProp, intPropRow, visCustPropsValue).FormulaU = ""
End If

vsoShape.Cells("Prop.DateRevised") = Format(Now(), "00000.00000")

End Sub

John Marshall… Visio MVP       Visio.MVPs.org