Calendar day numbers not showing

[fritz78]

We have a Monthly calendar file created in Visio 2002 and recently we have
upgraded to Visio 2003. For some reason we cannot get the actual day numbers
to appear in each day box on the calendar. These showed fine on the 2002
version but on the 2003 it is not working. Under custom properties we have
selected show week numbers to "yes" but they do not show. If I drag a new
calendar shape it seems to work, but it is a different style calendar.

Your assistance is greatly appreciated.

Fritz

 

[Aaron Rykhus [MSFT]]

This is a conversion issue with 2000/2002 calendar drawings opened in 2003.
There's code you can run on the drawing in a macro to fix it this that I
provided below. I'd suggest making a copy of any affected drawings to back
them up before running this macro just to be safe.

To create the macro and run the code fix follow these steps:
1. Open the affected drawing in Visio, on the Tools menu, point to Macros
and click Visual Basic Editor.
2. In the Microsoft Visual Basic window click Insert > Module
3. In the code window on the right paste in the following code below the
line.
4. Click on the Play button on the toolbar at the top, or press the F5 key
on the keyboard to run the macro code.
*You may need to lower the macro security under Tools > Macros > Security
in Visio to Medium and enable the macro before running.

----------------------------------------------------------------------------
-------------------------------------------
Sub UpdateLargeCalendar()

Dim pagesObj
Dim pageObj As Page
Dim cellVal
Dim sheetName
Dim shapeObj As Shape
Dim masterObj As Master

On Error Resume Next

Set pagesObj = ActiveDocument.Pages
If (False = IsNull(pagesObj)) Then
For iCnt = 1 To pagesObj.Count
Set pageObj = pagesObj.Item(iCnt)
If (False = IsNull(pageObj)) Then
Debug.Print "Page Name: " & pageObj.Name
For ishapesCnt = 1 To pageObj.Shapes.Count
Set shapeObj = pageObj.Shapes.Item(ishapesCnt)
If (False = IsNull(shapeObj)) Then
Debug.Print "Shape Instance name: " & shapeObj.Name
Set masterObj = shapeObj.Master
' Check master shape if it is available
If (Len(masterObj.NameU) >= 11) Then
cellVal = Null
cellVal = masterObj.NameU
If (Left(cellVal, 11) = "Large month") Then
GetShapeToModify shapeObj
End If
Else ' No Master, check universal name
cellVal = Null
cellVal = shapeObj.NameU
If (Left(cellVal, 11) = "Large month") Then
GetShapeToModify shapeObj
End If
End If
End If
Next ishapesCnt
End If
Next iCnt
End If
End Sub


Sub GetShapeToModify(shapeObj As Shape)
Dim basePtSize
Dim shapeObjSub As Shape
basePtSize = 0.0139 'value for one (1) point
sheetName = GetLowestSheetName(shapeObj)
Set shapeObjSub = shapeObj.Shapes(sheetName)
If (False = IsNull(shapeObjSub)) Then
cellVal = Null
cellVal = shapeObjSub.Cells("Char.Size").Result("Point")
If (cellVal > 0) Then
pointSize = cellVal * basePtSize
shapeObjSub.CellsSRC(visSectionParagraph, 0, visSpaceLine) =
pointSize
Debug.Print shapeObj.NameU & " calendar updated"
Else ' Set to a point size of 10 pt instead
pointSize = 10 * basePtSize
shapeObjSub.CellsSRC(visSectionParagraph, 0, visSpaceLine) =
pointSize
Debug.Print shapeObj.NameU & " calendar updated"
End If
End If

End Sub

' Return the shape's universal name with the lowest 'Sheet.n' number
Function GetLowestSheetName(shapeObj As Shape)

Dim lowestSheetName, currentLowestNumber, shapeSub
currentLowestNumber = 0
For ishapesCnt1 = 1 To shapeObj.Shapes.Count
Set shapeSub = shapeObj.Shapes.Item(ishapesCnt1)
If (False = IsNull(shapeSub)) Then
cellVal = Null
cellVal = shapeSub.NameU
If (Left(cellVal, 6) = "Sheet.") Then
Dim SheetNumber
SheetNumber = shapeSub.ID
If (currentLowestNumber = 0) Then
currentLowestNumber = SheetNumber
lowestSheetName = cellVal
ElseIf (SheetNumber < currentLowestNumber And
Len(SheetNumber) <= Len(currentLowestNumber)) Then
currentLowestNumber = SheetNumber
lowestSheetName = cellVal
End If
End If
End If
Next ishapesCnt1

GetLowestSheetName = lowestSheetName

End Function
----------------------------------------------------------------------------
-------------------------------------------


Best Regards,

Aaron Rykhus, MCP, MCDST
Online Support Engineer
Microsoft Corporation

 

[fritz78]

Thank You Aaron for your reply. The Macro you forwarded is coming up with a
Compile Error "Variable not defined" and highlights the first statement "Sub
UpdateLargeCalendar(). Not sure how to fix? Your help is very much
appreciated. THX! Fritz.

 

[Aaron Rykhus [MSFT]]

Sounds like some of the code is missing. Make sure all the code gets copied
into the module and that there's separators between the End Sub line and
the next Sub. I tested the code in 2003 on a calendar drawing created in
2002. I can export the code to a Basic File (*.bas) and attach to this post
if you have a newsreader like Outlook Express or Outlook (as opposed to the
web based view).


Best Regards,

Aaron Rykhus, MCP, MCDST
Online Support Engineer
Microsoft Corporation