Student Picture and Information List Generator

Why?

I used to work in a school. Staff who manage students constantly need to look up information from a sheet of document that they prepared in advance and printed out. It contains a picture of the student a several keyinformationsuch full name, age, etc.

This is an arduous task for them, as there are usually hundreds of students. To gather the pictures and information of so many students, could be a very repetitive and boring task, which can be done totally by using computer programming. Since they use MS Office Word to design this spread sheet, I will use VBA in Word.

How does it work?

I will use 2 spreadsheets for input. One spreadsheet stores the CIDs (Customer ID), where the students will be looked up, I will refer to this file as "CID.xls". The other spreadsheet is the database which contains the information of all the students, and I will refer to this file as "database.xls".

The program will read all the CID numbers from CID.xls, and look for the information in database.xls. The student pictures are on a network location, and they are named with the CID, so it's easy to get it. I assume the user has read permission to that network location.

Finally we put everything on a word document!

Interface Design

I will try to simplify the interface design, make it clean, straight-forward, and easy to use.

Behind Interface

When both CID.xls and database.xls are loaded, the 'Make List' button will be made available.

When 'Make List' Button is pressed, it will trigger the following code.

Private Sub bt_MakeList_Click()

Call PageSetup

' infor that print on list, must be same as database column titles
Dim firstName As String
firstName = "First Name"
Dim lastName As String
lastName = "Last Name"
Dim age As String
age = "Age"
Dim DOB As String
DOB = "DOB"

' inputs

Dim cidAddr As String
cidAddr = Main_SLP.tb_CIDFile.Value
Dim databaseAddr As String
databaseAddr = Main_SLP.tb_Database.Value

' outputs
Dim numCol As Integer
Dim numRow As Integer
Dim items(50) As String
Dim CID(100) As String

Dim data(100000) As String

' the number of processed student
Dim i As Integer
i = 1

Dim name As String
Dim infoArray(5) As String

Dim posNum As Integer

We first call "PageSetup" to setup the word document format (margins, orientation etc), and initialize the 4 types of info we will need to look up in the database for each student. Also, to initialize the input and out put variables.

' get cids
Call Access_Excel(cidAddr, numCol, numRow, items(), CID())

' get database
Call Access_Excel(databaseAddr, numCol, numRow, items(), data())

To access the two excel spreadsheet, we call Access_Excel(). After calling this function, all the data will be stored in the arrays, and file will be closed.

Do While Len(CID(i)) > 4

posNum = i Mod 8
If posNum = 0 Then
posNum = 8
End If

Call FindPic(CID(i), posNum)

We can then loop through the CIDs, to find and place the information in the Word Document. "posNum" is the position number ranged from 0 to 7, each number prensents a unique position on the document, so we have 2 rows in a Word documents, and 4 students each row.

"FindPic()" will take care of the picture searching, and placing the picture in the right place for us.

' form info array

name = "Name: " & SearchData(firstName, CID(i), data(), numCol * numRow, items())

name = name & " " & SearchData(lastName, CID(i), data(), numCol * numRow, items())

infoArray(1) = name
infoArray(2) = "DOB: " & SearchData(DOB, CID(i), data(), numCol * numRow, items()) _
& " (" & SearchData(age, CID(i), data(), numCol * numRow, items()) & ")"

infoArray(3) = "CID: " & CID(i)

Call PutInfo(infoArray(), posNum)

Next,  student information will be found, stored in "infoArray" and placed in the document by "PutInfor()".

i = i + 1

If i Mod 8 = 1 Then
ActiveDocument.Words.Last.Select
ActiveDocument.ActiveWindow.Selection.InsertBreak (wdPageBreak)
ActiveDocument.Words.Last.Select
End If

Loop

Finally we end the loop by incrementing i, and check the number of students on the current page. If there are 8, a new page is inserted and selected.

' free memory
Erase data()
Erase infoArray()
Erase CID()
Erase items()

End Sub

At last, we free the memory of the array, and end sub.

Functions  that are doing the work

Here are the functions that we manipulate above.

"PageSetup"

Sub PageSetup()

With ActiveDocument.PageSetup
.LeftMargin = InchesToPoints(0.5)
.RightMargin = InchesToPoints(0.5)
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.5)
.Orientation = wdOrientLandscape
End With

End Sub

Setup Active Document's margins, and orientation, very self explanatory. 

"Access_Excel()"

This function is the key of this program. Here is what it does:

  • Initialize variables
  • Open Excel and workbook
  • Start copying data into array
  • Close excel
  • Free memory

Function Access_Excel(fileAddr As String, ByRef numItem As Integer, ByRef numStudent As Integer, ByRef items() As String, ByRef data() As String)
' ByRef XXX as XXX --- is an output!


' init

Dim str As String
str = "init"

numItem = 0
numStudent = 1

' column number
Dim i As Integer
i = 0

' temp val
Dim k As Integer
k = 1

Dim itemPos(100) As String

Dim totalCol As Integer
totalCol = 1

Dim emptyCell As Boolean
emptyCell = False

Dim numDt As Integer
numDt = 1


Dim EOF1 As String
Dim EOF2 As String


Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

' turn off the screen updating
xlApp.ScreenUpdating = False

' open the source workbook, read only
Set database = xlApp.Workbooks.Open(fileAddr)
database.Worksheets(1).Select

'=========================================================

'start transfering data to memory (array)

i = 1
j = 2 ' first row is the titles
k = 1 ' temp val
str = "init"


' loop through students

Do

' copying row
Do

If itemPos(k) = i Then
data(numDt) = database.Worksheets(1).Cells(numStudent + 1, i).Value 'numStudent has offset 1 because of the title row
k = k + 1
numDt = numDt + 1
End If
i = i + 1

Loop Until k Mod (numItem + 1) = 0

'init again for next student
i = 1
k = 1
str = "init"
numStudent = numStudent + 1

' check for End of File
EOF1 = Len(database.Worksheets(1).Cells(numStudent, 1).Value)
EOF2 = Len(database.Worksheets(1).Cells(numStudent, 2).Value)

Loop Until (EOF1 = 0 And EOF2 = 0) Or (numStudent > 10000)



' turn on the screen updating
xlApp.ScreenUpdating = True

' close the source workbook without saving any changes
database.Close False
xlApp.Quit

' free memory
Set database = Nothing
Set xlApp = Nothing

Erase itemPos()


End Function

It might be very useful to make it read each column into a multi-dimension array, and take the column title as the key of the sub array. For example, a piece of data can be

output[col_title][row_number]

"FindPic()"

It basically just calculates the postion and dimension where and how to display the picuture. It then copy the picture and paste it on the document with the filename/path given. An error is prompted when picture doesn't exist. Notice  I used a customized function "File_Exists()" which is shown right after this.

'Extract Pictures

' cid... student number
' num is the postion, from top left to bottom right (0 - 7)

Sub FindPic(CID As String, num As Integer)

' initializing
Dim PicAddr As String
PicAddr = "\\xxx.xxx.xxx.xxx\g2-images\" & CID & ".jpg"

Dim H As Integer 'height
Dim W As Integer 'width

H = 200
W = 160

Dim X As Integer 'top left coordinate 1
Dim Y As Integer 'top left coordinate 2

X = 0
Y = 0

Dim row As Integer
Dim column As Integer


' calculate position
row = Switch(num = 1, 1, num = 2, 1, num = 3, 1, num = 4, 1, num = 5, 2, num = 6, 2, num = 7, 2, num = 8, 2)
column = Switch(num = 1, 1, num = 2, 2, num = 3, 3, num = 4, 4, num = 5, 1, num = 6, 2, num = 7, 3, num = 8, 4)

X = (column - 1) * 180
Y = (row - 1) * 270

If File_Exists(PicAddr, True) = True Then
ActiveDocument.Words.Last.Select

ActiveDocument.Shapes.AddPicture FileName:=PicAddr, LinkToFile:=False, Left:=X, Top:=Y, Width:=W, Height:=H, Anchor:=Selection.Range
Else
MsgBox "Student " & PicAddr & " does not have a picture"
End If

End Sub

"File_Exists()"

Used in FindPic() to check the existence of a picture.

Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean

'Returns True if the passed sPathName exist
'Otherwise returns False

On Error Resume Next
If sPathName <> "" Then

If IsMissing(Directory) Or Directory = False Then

File_Exists = (Dir$(sPathName) <> "")
Else

File_Exists = (Dir$(sPathName, vbDirectory) <> "")
End If

End If
End Function

"PutInfo()"

This is quite similar to FindPic(). It calculates the position, create a textbox below the picture, and drop the info there. Easy.

Sub PutInfo(data() As String, num As Integer)

Dim str As String
str = data(1)
Dim i As Integer
i = 2

Do While Len(data(i)) > 0
str = str & vbNewLine & data(i)
i = i + 1
Loop


Dim H As Integer 'height
Dim W As Integer 'width

H = 60
W = 160

Dim X As Integer 'top left coordinate 1
Dim Y As Integer 'top left coordinate 2


' calculate position
row = Switch(num = 1, 1, num = 2, 1, num = 3, 1, num = 4, 1, num = 5, 2, num = 6, 2, num = 7, 2, num = 8, 2)
column = Switch(num = 1, 1, num = 2, 2, num = 3, 3, num = 4, 4, num = 5, 1, num = 6, 2, num = 7, 3, num = 8, 4)

X = (column - 1) * 180 + 40
Y = (row - 1) * 270 + 240


Dim txtTitle As Word.Shape

'=============== CreateTextBox ===============

Set txtTitle = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, X, Y, W, H)

'==================== end ==================

txtTitle.TextFrame.ContainingRange.ParagraphFormat.SpaceAfter = 0
txtTitle.TextFrame.TextRange = str



End Sub

Not All 

I haven't shown you all the functions yet. They are for verifying user inputs such as the database, checking if it has got the right title/columns etc. But they are not necessary to the program, so I will leave them in the source code file and you can take a look if you are interested.

Format of the Spreadsheet

It's important that the user has to follow these rules on the format of the spreadsheet. Columns cannot be added, deleted, or changed order, Titles must stay the same. It's advised to copy and paste data into the template rather than creating a new one to avoid user error.

Known Bugs

Due to the limitation in integer data type, the range is -32768 to 32767 (integer use 2 bytes, 16 bits), which limits the number of data can be stored in an array. So if we have more than 32767 cells in the database, the program will crashed due to overflow.

To solve this we could use Long data type instead of Integer, which has a range of -2147483648 to 2147483647.

But most of the time, it's the user that accidentally change the titles in the database columns.