Home › Blogs › christianmlong's blog

Automatic printing of handwriting worksheets for kids

Mon, 2005-11-28 02:44 — christianmlong

This bit of VBScript reads the words in a text file, and uses a blank, formatted Word document to print those words in worksheet format.

Good handwriting tracing fonts for kids are hard to find. Here is a good overview, with links to some good ones:

Free Handwriting Fonts for Teachers.

I'm using Print Clearly, from the fontsters of Blue Vinyl. I'm using the TrueType version, not OpenType, since the OpenType version does not behave properly at large sizes on my Win2k/Word2k setup.


Const wdGoToBookmark = -1
Const wdDoNotSaveChanges = 0
Const wdPageBreak = 7

Const ForReading = 1, ForWriting = 2, ForAppending = 8

Const path = "C:\Path\To\Folder\"
Const documentFile = "Writing worksheet.doc"
Const listFile = "word list.txt"


Dim documentPath
Dim listPath
documentPath = path & documentFile
listPath = path & listFile


Dim wordApp
Dim wordDoc
Dim wordRange
Dim i
Dim theWord
Dim fso
Dim theOpenFile
Dim answer
Dim firstWord

answer = MsgBox ("Print all words in " & listPath & " ?", vbOKCancel)


If answer = vbOK Then
  Set wordApp = CreateObject("Word.Application")
  Set wordDoc = wordApp.Documents.Open(documentPath)
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set theOpenFile = fso.OpenTextFile(listPath, ForReading)

  'wordApp.Visible = True

  firstWord = True

  ' Open word list, and generate document
  Do Until theOpenFile.AtEndOfStream
    theWord = theOpenFile.ReadLine
  
    ' Avoid blank lines and blank pages
    If len(trim(theWord)) > 0 Then
      If firstWord Then
        firstWord = False
      Else
        wordApp.Selection.InsertBreak wdPageBreak
      End If
      For i = 1 to 3
        wordApp.Selection.TypeText theWord
        wordApp.Selection.TypeParagraph
      Next
    End If
  Loop

  theOpenFile.Close


  ' print the document.
  wordApp.Options.PrintBackground = False
  wordApp.ActiveDocument.PrintOut

  wordApp.Application.Quit wdDoNotSaveChanges
  Set wordApp = Nothing
End If