Student Picture/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 and several key information such 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.

So, I made this awesome application in VBA in summer 2010 to help them save time.

This application has been tested in MS Office 2010/2007/2003 and working.

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.

SLP2

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.

[sourcecode lanague=”vb”]

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
[/sourcecode]

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.

[sourcecode lanague=”vb”]
.
‘ get cids
Call Access_Excel(cidAddr, numCol, numRow, items(), CID())

‘ get database
Call Access_Excel(databaseAddr, numCol, numRow, items(), data())
[/sourcecode]

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.

[sourcecode lanague=”vb”]
Do While Len(CID(i)) > 4

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

Call FindPic(CID(i), posNum)
[/sourcecode]

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.

[sourcecode lanague=”vb”]
‘ 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)
[/sourcecode]

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

[sourcecode lanague=”vb”]
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
[/sourcecode]

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.

[sourcecode lanague=”vb”]
‘ free memory
Erase data()
Erase infoArray()
Erase CID()
Erase items()

End Sub
[/sourcecode]

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”

[sourcecode lanague=”vb”]
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
[/sourcecode]

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

[sourcecode lanague=”vb”]
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
[/sourcecode]

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.

[sourcecode lanague=”vb”]
‘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.xxxg2-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
[/sourcecode]

“File_Exists()”

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

[sourcecode lanague=”vb”]
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
[/sourcecode]

“PutInfo()”

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

[sourcecode lanague=”vb”]
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
[/sourcecode]

Not All

I haven’t posted 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.

SLP3

SLP4

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 when errors happen, it’s usually the user accidentally changes the titles in the database columns.

Leave a Reply

Your email address will not be published. Required fields are marked *

Are you Robot? *

I don't look at blog comments very often (maybe once or twice a week), so if you have any questions related to multirotor please post it on this forum IntoFPV.com... You're likely to get a response from me faster on there.