CorelDRAW X3 VBA Code - Shape & Color LIster

I am not new to programming, but I am painfully new to CorelDRAW VBA. I have written two very simple routines previously and would like to get some feedback on this third routine and accompanying function. It is meant to loop through all the pages, layers, and shapes in the active document and write each of the shapes, descriptions, fill colors, and outline colors to a text file. It is working.

I don't have any bells and whistles -- no prompting for filenames, checking for existence of file, etc. I am trying to get the basics and some feedback first.

Based on the preview of my email, I also don't understand the instructions for formatting the code properly; so, I would appreciate help on that also.

Code:
Sub ShapesColorCount()
'===================================================================================
' This routine loops through all the pages and layers of the active document and
' writes a description of each shape, along with the uniform fill and outline color
'===================================================================================

Dim myDoc As Document
Dim myPages As Page
Dim intI As Integer
Dim intJ As Integer
Dim intK As Integer
Dim intShapeCt As Integer
Dim intShapeType As Integer
Dim intButton As Integer
Dim intResponse As Integer
Dim strTitle As String
Dim strMessage As String
Dim strShapeName As String
Dim strText As String

'===================================================================================
' Open output file
'===================================================================================

Open "C:\Testfile.txt" For Output As #1

'===================================================================================
' Declare variables
'===================================================================================
intShapeCt = ActiveLayer.Shapes.Count
strTitle = "Color Lister"

'===================================================================================
' If there's no shape on the page, issue error and exit routine
'===================================================================================
If intShapeCt = 0 Then
strMessage = "There are no shapes"
intButton = vbOKOnly + vbExclamation
intResponse = MsgBox(strMessage, intButton, strTitle)
GoTo ExitRoutine
End If

'===================================================================================
' Set Environment
'===================================================================================
Set myDoc = ActiveDocument

'===================================================================================
'Main Process
' Loop through shapes on each layer on each page and write the shape name, fill
' color and outline color to a text file.
'===================================================================================
For intJ = 1 To myDoc.Pages.Count
For intK = 1 To myDoc.Pages(intJ).Layers.Count
For intI = 1 To intShapeCt
With ActiveLayer.Shapes(intI).Fill.UniformColor
intShapeType = .Type

'Call Function and pass shape number - function returns name
Call ShapeName(intShapeType, strShapeName)

strText = "Shape # " & intI & " " & strShapeName
Print #1, strText
strText = "Fill Color = " & .Name
Print #1, Tab(15); strText
strText = "Components = " & .Name(True)
Print #1, Tab(15); strText
End With
If ActiveLayer.Shapes(intI).Outline.Width = 0 Then
strText = "No outline"
Print #1, Tab(15); strText
Else
strText = "Outline Width = " & _
ActiveLayer.Shapes(intI).Outline.Width
Print #1, Tab(15); strText
strText = "Outline Color = " & _
ActiveLayer.Shapes(intI).Outline.Color.Name
Print #1, Tab(15); strText
End If
Next intI
Next intK
Next intJ

ExitRoutine:
Close #1

strMessage = "Process Complete"
intButton = vbOKOnly + vbInformation
intResponse = MsgBox(strMessage, intButton, strTitle)

End Sub

Sub ShapesColorCount()
'===================================================================================
' This routine loops through all the pages and layers of the active document and
' writes a description of each shape, along with the uniform fill and outline color
'===================================================================================

Dim myDoc As Document
Dim myPages As Page
Dim intI As Integer
Dim intJ As Integer
Dim intK As Integer
Dim intShapeCt As Integer
Dim intShapeType As Integer
Dim intButton As Integer
Dim intResponse As Integer
Dim strTitle As String
Dim strMessage As String
Dim strShapeName As String
Dim strText As String

'===================================================================================
' Open output file
'===================================================================================

Open "C:\Testfile.txt" For Output As #1

'===================================================================================
' Declare variables
'===================================================================================
intShapeCt = ActiveLayer.Shapes.Count
strTitle = "Color Lister"

'===================================================================================
' If there's no shape on the page, issue error and exit routine
'===================================================================================
If intShapeCt = 0 Then
strMessage = "There are no shapes"
intButton = vbOKOnly + vbExclamation
intResponse = MsgBox(strMessage, intButton, strTitle)
GoTo ExitRoutine
End If

'===================================================================================
' Set Environment
'===================================================================================
Set myDoc = ActiveDocument

'===================================================================================
'Main Process
' Loop through shapes on each layer on each page and write the shape name, fill
' color and outline color to a text file.
'===================================================================================
For intJ = 1 To myDoc.Pages.Count
For intK = 1 To myDoc.Pages(intJ).Layers.Count
For intI = 1 To intShapeCt
With ActiveLayer.Shapes(intI).Fill.UniformColor
intShapeType = .Type

'Call Function and pass shape number - function returns name
Call ShapeName(intShapeType, strShapeName)

strText = "Shape # " & intI & " " & strShapeName
Print #1, strText
strText = "Fill Color = " & .Name
Print #1, Tab(15); strText
strText = "Components = " & .Name(True)
Print #1, Tab(15); strText
End With
If ActiveLayer.Shapes(intI).Outline.Width = 0 Then
strText = "No outline"
Print #1, Tab(15); strText
Else
strText = "Outline Width = " & _
ActiveLayer.Shapes(intI).Outline.Width
Print #1, Tab(15); strText
strText = "Outline Color = " & _
ActiveLayer.Shapes(intI).Outline.Color.Name
Print #1, Tab(15); strText
End If
Next intI
Next intK
Next intJ

ExitRoutine:
Close #1

strMessage = "Process Complete"
intButton = vbOKOnly + vbInformation
intResponse = MsgBox(strMessage, intButton, strTitle)

End Sub


Thanks, Judy