Visual Basic 6.0 (VB6) 程式語言案例學習 (03. 單位財產清點系統)¶

3.1 問題¶

某單位的一位組長，因為對於電腦操作能力不足，無法使用現有的Excel來計算統計，他一向使用Word製作出紙本表單，然後帶著一疊表單去一一檢查教室的設備，這個方式已經使用了好幾年，而且統計的時候他也是按著計算機跟在Word打字。完全對於Excel試算表的功能相當排斥，也許對於他來說實在是太複雜了。
有天單位配給他一台筆記型電腦，他突發奇想如果只要帶著筆記型電腦就可以登記清點教室財產，那會是一件多麼方便的事情，因此提案希望能夠有一套滿足他需求的程式，帶著筆記型電腦就可以完成工作。
但他要求程式要與他的紙本表單格式相同，這樣才能方便他上手，他不允許格式不同，而且毫無妥協的餘地，可以說相當蠻橫。因為他認為他的無敵表單是辛苦的結晶，神聖而不容侵犯。可是他的表單已經被設計的只有他才看得懂，而且字級大多小於8，並且爬滿了整張A4紙。

3.2 需求¶

表格 3‑1 「單位財產清點系統」系統目的分析表

版本：1.0	要做什麼	不要做什麼（不要做不代表不會做）
能做什麼	（第一格：必要項目）	（第二格：次要項目）
	要依據已有的紙本表單設計單位財產清點介面。（否則不驗收）	能得知班級資訊、教師姓名、股長姓名。
	要能自由設定不同學期的班級，而且只要上學期設定一次，系統會自動產生下學期的資料。	能夠與學生資料庫作連結。
	要能自由設定位置。	包含賠償帳管系統。
	要能自由設定問題。
	要能自由設定建物。
	所謂自由設定就是包含編號也可以隨時修改，但卻不能影響到資料。
	要具有多重統計的功能，得以隨時勾選要統計的班級及問題。
	除了基本列印單據之外，還要能夠匯出成為Excel檔。
	程式啟動畫面的功能鈕，要非常大。（否則不驗收）
不能做什麼（不能做代表不需要做）	（第三格：不必要項目）	（第四格：不需要項目）
	使用Crystal Report建立群組化報表。	將其整合到校務系統中，將資訊公開於網站上。

表格 3‑2 「單位財產清點系統」系統目標分析表

版本：	重要	不重要
優先	（重）	（急）
	要依據已有的紙本表單設計單位財產清點介面。	要能自由設定不同學期的班級，而且只要上學期設定一次，系統會自動產生下學期的資料。
	所謂自由設定就是包含編號也可以隨時修改，但卻不能影響到資料。	要能自由設定位置。
	程式啟動畫面的功能鈕，要非常大。	要能自由設定問題。
		要能自由設定建物。
不急迫	（輕）	（緩）
	要具有多重統計的功能，得以隨時勾選要統計的班級及問題。	除了基本列印單據之外，還要能夠匯出成為Excel檔。

表格 3‑3 「單位財產清點系統」系統規格表

規格項目	規格內容	備註
程式啟動畫面	程式啟動畫面的功能鈕，要非常大。（重要）	…
登錄、查詢、修改	要依據已有的紙本表單設計單位財產清點介面。（重要）	…
統計、列印	要具有多重統計的功能，得以隨時勾選要統計的班級及問題。	…
	除了基本列印單據之外，還要能夠匯出Excel檔。
設定	所謂自由設定就是包含編號也可以隨時修改，但卻不能影響到資料。
	要能自由設定不同學期的班級，而且只要上學期設定一次，系統會自動產生下學期的資料。
	要能自由設定位置。
	要能自由設定問題。
	要能自由設定建物。	…

3.3 特色¶

特點就是透過筆記型電腦，至各教室清點損壞項目，回來後可上傳至伺服器中，供維修人員參考。在程式方面採用物件設計法，節省了設計的開發時效。 可應用於盤點系統。
倘若您修改了介面之後，這套程式會因為您的修改變得更符合您的需求。

3.4 使用工具¶

語言	軟體
Visual Basic 6.0	MS Visual Basic 6.0、MS Access

3.5 系統架構¶

筆者與使用者訪談之後，發現基本上需求是因為統計報表製作困難，所以才需要本程式的協助，其實他的需求很有道理，就是將紙本資料電腦化，這點筆者也十分認同，不過筆者建議直接採用Excel就可以完成了，而且十分簡單易懂，但對於使用者不懂Excel也不願學習，因此開發本程式是有其必要性。
可是需求者有一項十分堅持的觀念，就是操作介面非得依照他的表單而設計，否則就是不驗收，面對這個問題，筆者轉而求其次，開始認真分析他的表單製作過程，因而找到同質性，藉由同質性的方式，可將共用的參數都撰寫在一個元件中，然後使用元件可再用性的特質，創建出大元件的面，就這樣解決了問題。
其餘的資料統計部分是相當簡單的加減運算，一兩個迴圈就解決了，對於資料庫的運作也只是資料進出存取而已，有經驗的讀者相信也認為不值得一提了。因此程式實作的部分，筆者將只介紹元件的程式碼，但在光碟片中筆者一樣保留整個系統的完整程式碼給讀者們自由使用。

3.6 程式實作¶

Step 1：課桌椅元件，請參考如圖3-1。

圖 3‑1 課桌椅元件

Step 2：請參考以下程式碼。

‘設定所有變數必須宣告才能使用
Option Explicit
‘宣告連線字串變數
Public strCnn As String
‘宣告ADO資料庫連結物件
Public objCnnItem As ADODB.Connection
‘宣告項目識別碼字串變數
Public strItemID  As String
‘宣告項目字串變數
Public strItem    As String
‘宣告年度字串變數
Public strLevel   As String
‘宣告學期字串變數
Public strLevelNo As String
‘宣告班級字串變數
Public strUnit    As String
‘宣告地點字串變數
Public strPlace   As String
‘使用此函數傳遞參數
Private Declare Function SendMessage Lib “user32” Alias “SendMessageA” _
                         (ByVal hwnd As Long, _
                          ByVal wMsg As Long, _
                          ByVal wParam As Long, _
                          lParam As Long) As Long
‘設定下拉式選單寬度所使用的常數
Const CB_SETDROPPEDWIDTH = &H160
‘宣告事件，元件滑鼠鍵按下事件
Event MouseDown(Button, Shift, X, Y)
‘宣告事件，元件重新整理事件
Event Refresh()
‘宣告讀出項目代碼屬性
Public Property Get SetItemID() As Variant
End Property
‘宣告設定項目代碼屬性
Public Property Let SetItemID(ByVal vNewValue As Variant)
    ‘將新值設定給元件全域變數
    strItemID = vNewValue
End Property
‘宣告讀出年度屬性
Public Property Get SetLevel() As Variant
End Property
‘宣告設定年度屬性
Public Property Let SetLevel(ByVal vNewValue As Variant)
    ‘將新值設定給元件全域變數
    strLevel = vNewValue
End Property
‘宣告讀出學期屬性
Public Property Get SetLevelNo() As Variant
End Property
‘宣告設定學期屬性
Public Property Let SetLevelNo(ByVal vNewValue As Variant)
    ‘將新值設定給元件全域變數
    strLevelNo = vNewValue
End Property
‘宣告讀出班級屬性
Public Property Get SetUnit() As Variant
End Property
‘宣告設定班級屬性
Public Property Let SetUnit(ByVal vNewValue As Variant)
    ‘將新值設定給元件全域變數
    strUnit = vNewValue
End Property
‘宣告讀出地點屬性
Public Property Get SetPlace() As Variant
End Property
‘宣告設定地點屬性
Public Property Let SetPlace(ByVal vNewValue As Variant)
    ‘將新值設定給元件全域變數
    strPlace = vNewValue
End Property
‘宣告讀出資料庫連結物件
Public Property Get SetCnnDB() As ADODB.Connection
End Property
‘宣告設定資料庫連結物件
Public Property Let SetCnnDB(ByVal vNewValue As ADODB.Connection)
    ‘將新值設定給元件全域變數
    Set objCnnItem = vNewValue
End Property
‘課桌展開鈕被點選事件副程式
Private Sub cmdItem_A_Click()
    ‘當按鈕名稱為展開時
    If cmdItem_A.Caption = “展開” Then
       ‘顯示關閉
       cmdItem_A.Caption = “關閉”
       ‘課椅按鈕禁能
       cmdItem_B.Enabled = False
       ‘設定目前項目為課桌
       strItem = “課桌”
       ‘載入問題清單
       Call LoadDB_Tproblem
       ‘載入已登報問題項目
       Call LoadDB_Tlist
       ‘設定顏色
       cboItem_A.BackColor = &HFFFFFF
       txtItem_A.BackColor = &HFFFFFF
       ‘調整寬度
       Extender.Width = 5400
       ‘設定文字框啟用
       txtItem_A.Enabled = True
    ‘當按鈕名稱為關閉時
    ElseIf cmdItem_A.Caption = “關閉” Then
       ‘設定顏色
       cboItem_A.BackColor = &H80000004
       txtItem_A.BackColor = &H80000004
       ‘設定名稱為展開
       cmdItem_A.Caption = “展開”
       ‘課椅按鈕啟用
       cmdItem_B.Enabled = True
       ‘清除載入資料
       Call ClearDB_Tlist
       ‘寫入載入資料
       Call WriteDB_Tlist
       ‘清除代碼
       strItem = “”
       ‘調整寬度為較小
       Extender.Width = 2400
       ‘禁用文字輸入框
       txtItem_A.Enabled = False
    End If
End Sub

‘課椅展開鈕被點選事件副程式
Private Sub cmdItem_B_Click()
    ‘當課椅按鈕名稱為展開時
    If cmdItem_B.Caption = “展開” Then
       ‘設定名稱為關閉
       cmdItem_B.Caption = “關閉”
       ‘禁止課桌按鈕使用
       cmdItem_A.Enabled = False
       ‘設定代碼為課椅
       strItem = “課椅”
       ‘載入損壞問題清單
       Call LoadDB_Tproblem
       ‘載入已登報問題
       Call LoadDB_Tlist
       ‘設定顏色
       cboItem_B.BackColor = &HFFFFFF
       txtItem_B.BackColor = &HFFFFFF
       ‘設定寬度變大
       Extender.Width = 5400
       ‘文字框輸入啟用
       txtItem_B.Enabled = True
    ‘當課椅按鈕名稱為關閉時
    ElseIf cmdItem_B.Caption = “關閉” Then
       ‘設定顏色
       cboItem_B.BackColor = &H80000004
       txtItem_B.BackColor = &H80000004
       ‘設定名稱為展開
       cmdItem_B.Caption = “展開”
       ‘啟用課桌按鈕
       cmdItem_A.Enabled = True
       ‘清除資料
       Call ClearDB_Tlist
       ‘寫入資料
       Call WriteDB_Tlist
       ‘清除代碼
       strItem = “”
       ‘縮小元件大小
       Extender.Width = 2400
       ‘文字框禁用
       txtItem_B.Enabled = False
    End If
End Sub

‘數量增加按鈕點選事件副程式
Private Sub cmdItem_NumAdd_Click()
    ‘宣告數量變數
    Dim intItemNum As Integer
    ‘當清單項目沒有時
    If lvwItem.ListItems.Count <= 0 Then
       ‘跳離副程式
       Exit Sub
    End If
    ‘當清單項目沒有被勾選時
    If lvwItem.SelectedItem.Checked = False Then
       ‘跳離副程式
       Exit Sub
    End If
    ‘取得項目數量
    intItemNum = Val(lvwItem.SelectedItem.SubItems(1))
    ‘項目數量累加1
    intItemNum = intItemNum + 1
    ‘當項目超過100時
    If intItemNum > 100 Then
       ‘設定數量為99
       intItemNum = 99
    End If
    ‘設定清單上的項目數量
    lvwItem.SelectedItem.SubItems(1) = intItemNum
End Sub

‘數量減少按鈕點選事件副程式
Private Sub cmdItem_NumDec_Click()
    ‘宣告數量變數
    Dim intItemNum As Integer
    ‘當清單項目沒有時
    If lvwItem.ListItems.Count <= 0 Then
       ‘跳離副程式
       Exit Sub
    End If
    ‘當清單項目沒有被勾選時
    If lvwItem.SelectedItem.Checked = False Then
       ‘跳離副程式
       Exit Sub
    End If
    ‘取得項目數量
    intItemNum = Val(lvwItem.SelectedItem.SubItems(1))
    ‘項目數量減1
    intItemNum = intItemNum – 1
    ‘當項目小於1時
    If intItemNum < 1 Then
       ‘設定數量為0
       intItemNum = 0
    End If
    ‘設定清單上的項目數量
    lvwItem.SelectedItem.SubItems(1) = intItemNum
End Sub

‘破壞問題項目被勾選時事件副程式
Private Sub lvwItem_ItemCheck(ByVal Item As MSComctlLib.ListItem)
    ‘當沒有被勾選時
    If Item.Checked = False Then
       ‘清空項目數量
       Item.SubItems(1) = “”
    ‘當被勾選時
    ElseIf Item.Checked = True Then
       ‘設定項目數量為1
       Item.SubItems(1) = “1”
    End If
End Sub

‘課桌椅元件初始化事件副程式
Private Sub UserControl_Initialize()
    ‘初始化變數
    strItem = “”
    strItemID = “”
End Sub

‘課桌椅元件重新顯示事件副程式
Public Sub Refresh()
    ‘釋放重新顯示的事件給外部使用
    RaiseEvent Refresh
    ‘讓電腦有時間處理其他事務
    DoEvents
    ‘初始化控制項
    cboItem_A.BackColor = &H80000004
    txtItem_A.BackColor = &H80000004
    txtItem_A.Text = “”
    cboItem_B.BackColor = &H80000004
    txtItem_B.BackColor = &H80000004
    txtItem_B.Text = “”
    ‘預設代碼為課桌
    strItem = “課桌”
    ‘載入問題項目清單
    Call LoadDB_Tproblem
    ‘載入已登報項目
    Call LoadDB_Tlist
    ‘當下拉式選單大於零時
    If cboItem_A.ListCount > 0 Then
       ‘設定選擇第一筆資料
       cboItem_A.ListIndex = 0
    End If
    ‘在標籤上的提示文字顯示第幾排第幾列
    labItem(0).ToolTipText = “第” & Replace(Right(“00” & Mid$(strItemID, 1, 2), 2), “-“, “”) & “排 x “ & _
                             “第” & Right(“00” & Mid$(strItemID, 3, 2), 2) & “列”
    ‘預設代碼為課椅
    strItem = “課椅”
    ‘載入問題項目清單
    Call LoadDB_Tproblem
    ‘載入已登報項目
    Call LoadDB_Tlist
    ‘當下拉式選單大於零時
    If cboItem_B.ListCount > 0 Then
       ‘設定選擇第一筆資料
       cboItem_B.ListIndex = 0
    End If
    ‘在標籤上的提示文字顯示第幾排第幾列
    labItem(1).ToolTipText = “第” & Replace(Right(“00” & Mid$(strItemID, 1, 2), 2), “-“, “”) & “排 x “ & _
                             “第” & Right(“00” & Mid$(strItemID, 3, 2), 2) & “列”
    ‘設定標籤文字
    labItem(1).Caption = Replace(Right(“00” & Mid$(strItemID, 1, 2), 2), “-“, “”) & “ – “ & _
                         Right(“00” & Mid$(strItemID, 3, 2), 2)
End Sub

‘課桌椅元件大小調整事件副程式
Private Sub UserControl_Resize()
    ‘圖形寬度調整
    Shape1.Width = Extender.Width
End Sub

‘課桌椅元件滑鼠鍵按下事件副程式
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ‘將事件權限釋放給外部使用
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

‘載入破壞問題資料副程式
Private Sub LoadDB_Tproblem()
    ‘宣告SQL字串變數
    Dim strSQL  As String
    ‘宣告ADO資料錄物件
    Dim objRst  As ADODB.Recordset
    ‘宣告清單項目物件
    Dim objItem As ListItem
    ‘設定SQL命令文字
    strSQL = “Select [pbID],[class],[name],[intPrice] From Tproblem “ & _
             “Where [class] Like ‘” & strItem & “’ “ & _
             “Order By [pbid]”
    ‘建立ADO資料錄物件
    Set objRst = New ADODB.Recordset
    ‘開啟資料錄
    objRst.Open strSQL, objCnnItem, adOpenKeyset, adLockOptimistic
    ‘清空項目
    lvwItem.ListItems.Clear
    ‘巡覽所有資料錄
    Do Until objRst.EOF
       ‘設定資料錄內容到清單項目中
       Set objItem = lvwItem.ListItems.Add(, Trim(objRst(“pbID”)), Trim(objRst(“name”)))
           objItem.SubItems(2) = Trim(objRst(“pbID”))
           objItem.SubItems(3) = Trim(objRst(“intPrice”))
       ‘移動資料錄到下一筆
       objRst.MoveNext
    Loop
    ‘關閉資料錄
    objRst.Close
End Sub

‘載入已登報問題資料副程式
Private Sub LoadDB_Tlist()
    ‘宣告SQL字串變數
    Dim strSQL  As String
    ‘宣告ADO資料錄物件
    Dim objRst  As ADODB.Recordset
    ‘宣告清單項目物件
    Dim objItem As ListItem
    ‘設定SQL命令文字，尋找已登報的資料
    strSQL = “Select [itemID],[Tlist].[pbID],[Tproblem].[pbID],[Tproblem].[name],” & _
                    “[Tlist].[itemNum],[Tlist].[itemNo],” & _
     “[Tlist].[itemLevel],[Tlist].[itemLevelNo],[Tlist].[itemUnit],[Tlist].[itemPlace]” & _
                    “ From Tlist,Tproblem “ & _
             “Where [itemID] Like ‘” & strItemID & fChoice() & “’ And “ & _
                   “[Tlist].[itemLevel] Like ‘” & strLevel & “’ And “ & _
                   “[Tlist].[itemLevelNo] Like ‘” & strLevelNo & “’ And “ & _
                   “[Tlist].[itemUnit] Like ‘” & strUnit & “’ And “ & _
                   “[Tlist].[itemPlace] Like ‘” & strPlace & “’ And “ & _
                   “[Tlist].[pbID] = [Tproblem].[pbID] “ & _
             “Order By [listID]”
    ‘建立ADO資料錄物件
    Set objRst = New ADODB.Recordset
    ‘開啟資料錄
    objRst.Open strSQL, objCnnItem, adOpenKeyset, adLockOptimistic
    ‘判斷代碼為桌
    If fChoice() = “桌” Then
       ‘清除課桌下拉式選單
       cboItem_A.Clear
    ‘判斷代碼為椅
    ElseIf fChoice = “椅” Then
       ‘清除課椅下拉式選單
       cboItem_B.Clear
    End If
    ‘巡覽所有資料錄
    Do Until objRst.EOF
       ‘尋找項目
       Set objItem = lvwItem.FindItem(Trim(objRst(“Tlist.pbID”)), 1)
       ‘當發現項目存在時
       If Not (objItem Is Nothing) Then
          ‘勾選項目
          objItem.Checked = True
          ‘並設定項目數量
          objItem.SubItems(1) = objRst(“itemNum”)
          ‘假如代碼為桌
          If fChoice() = “桌” Then
             ‘設定顏色
             cboItem_A.BackColor = &HFFFFFF
             txtItem_A.BackColor = &HFFFFFF
             ‘下拉式選單增加項目
             cboItem_A.AddItem objRst(“name”) & “X” & objRst(“itemNum”)
             txtItem_A.Text = Trim(objRst(“itemno”) & “”)
          ‘假如代碼為椅
          ElseIf fChoice = “椅” Then
             ‘設定顏色
             cboItem_B.BackColor = &HFFFFFF
             txtItem_B.BackColor = &HFFFFFF
             ‘下拉式選單增加項目
             cboItem_B.AddItem objRst(“name”) & “X” & objRst(“itemNum”)
             txtItem_B.Text = Trim(objRst(“itemno”) & “”)
          End If
       End If
       ‘將資料錄往下移動一筆
       objRst.MoveNext
    Loop
    ‘關閉資料錄
    objRst.Close
End Sub

‘清除已登報問題資料副程式
Private Sub ClearDB_Tlist()
    ‘宣告SQL字串變數
    Dim strSQL  As String
    ‘宣告ADO資料錄物件
    Dim objRst  As ADODB.Recordset
    ‘設定SQL命令文字，要刪除報修項目
    strSQL = “Delete [itemID] “ & _
             “From Tlist “ & _
             “Where [itemID] Like ‘” & strItemID & fChoice() & “’ And “ & _
                   “[Tlist].[itemLevel] Like ‘” & strLevel & “’ And “ & _
                   “[Tlist].[itemLevelNo] Like ‘” & strLevelNo & “’ And “ & _
                   “[Tlist].[itemUnit] Like ‘” & strUnit & “’ And “ & _
                   “[Tlist].[itemPlace] Like ‘” & strPlace & “’”
    ‘建立ADO資料錄物件
    Set objRst = New ADODB.Recordset
    ‘開啟資料錄
    objRst.Open strSQL, objCnnItem, adOpenKeyset, adLockOptimistic
End Sub

‘寫入有問題項目資料副程式
Private Sub WriteDB_Tlist()
    ‘當條件不足時
    If strLevel = “” Or _
       strLevelNo = “” Or strUnit = “” Or _
       strPlace = “” Then
       ‘跳離副程式
       Exit Sub
    End If
    ‘宣告SQ命令字串變數
    Dim strSQL    As String
    ‘宣告ADO資料錄物件
    Dim objRst    As ADODB.Recordset
    ‘宣告項目清單物建
    Dim objItem   As ListItem
    ‘宣告計數變數
    Dim intI      As Integer
    ‘宣告代碼字串變數
    Dim strListID As String
    ‘宣告計數變數
    Dim intCount  As Integer
    ‘宣告編號字串變數
    Dim strItemNo As String
    ‘當判斷代碼是桌
    If fChoice() = “桌” Then
       ‘清空課桌下拉式選單
       cboItem_A.Clear
       ‘設定編號
       strItemNo = Trim(txtItem_A.Text)
    ‘當判斷代碼是椅
    ElseIf fChoice = “椅” Then
       ‘清空課椅下拉式選單
       cboItem_B.Clear
       ‘設定編號
       strItemNo = Trim(txtItem_B.Text)
    End If
    ‘初始化計數器
    intCount = 0
    ‘巡覽清單所有資料
    For intI = 1 To lvwItem.ListItems.Count
        ‘假設有被勾選
        If lvwItem.ListItems(intI).Checked = True Then
           ‘計數器累加1
           intCount = intCount + 1
           ‘設定代碼字串
           strListID = Right(“0000” & Year(Date), 4) & _
                       Right(“00” & Month(Date), 2) & _
                       Right(“00” & Day(Date), 2) & _
                       Right(“00” & Hour(Time), 2) & _
                       Right(“00” & Minute(Time), 2) & _
                       Right(“00” & Second(Time), 2) & _
                       Right(“000” & Trim(Str(intCount)), 3)
           ‘設定新增資料SQL命令
           strSQL = “INSERT INTO Tlist “ & _
                    “(listID,itemID,pbID,itemNum,itemNo,” & _
                     “itemLevel,itemLevelNo,itemUnit,itemPlace,itemSum) VALUES “ & _
                    “(‘” & strListID & “’,’” & _
                           strItemID & fChoice() & “’,’” & _
                           lvwItem.ListItems(intI).SubItems(2) & “’,’” & _
                           lvwItem.ListItems(intI).SubItems(1) & “’,’” & _
                           strItemNo & “’,’” & _
                           strLevel & “’,’” & _
                           strLevelNo & “’,’” & _
                           strUnit & “’,’” & _
                           strPlace & “’,’” & _
                           Trim(Str(Val(lvwItem.ListItems(intI).SubItems(3)) * Val(lvwItem.ListItems(intI).SubItems(1))) & “”) & “’) “
           ‘執行SQL命令
           objCnnItem.Execute strSQL
           ‘當代碼為桌
           If fChoice() = “桌” Then
              ‘在課桌下拉式選單中增加項目
              cboItem_A.AddItem lvwItem.ListItems(intI).Text & “X” & lvwItem.ListItems(intI).SubItems(1)
           ‘當代碼為椅
           ElseIf fChoice = “椅” Then
              ‘在課椅下拉式選單中增加項目
              cboItem_B.AddItem lvwItem.ListItems(intI).Text & “X” & lvwItem.ListItems(intI).SubItems(1)
           End If
         End If
    Next intI
    ‘當代碼為桌
    If fChoice() = “桌” Then
       ‘而項目數量大於零
       If cboItem_A.ListCount > 0 Then
          ‘設定選擇及顏色
          cboItem_A.ListIndex = 0
          cboItem_A.BackColor = &HFFFFFF
          txtItem_A.BackColor = &HFFFFFF
       ‘反之
       Else
          ‘清空文字框
          txtItem_A.Text = “”
       End If
    ‘當代碼為椅
    ElseIf fChoice = “椅” Then
       ‘而項目數量大於零
       If cboItem_B.ListCount > 0 Then
          ‘設定選擇及顏色
          cboItem_B.ListIndex = 0
          cboItem_B.BackColor = &HFFFFFF
          txtItem_B.BackColor = &HFFFFFF
       ‘反之
       Else
          ‘清空文字框
          txtItem_B.Text = “”
       End If
    End If
End Sub

‘代碼轉換函式
Public Function fChoice() As String
    If strItem = “課桌” Then
       fChoice = “桌”
    ElseIf strItem = “課椅” Then
       fChoice = “椅”
    End If
End Function

Step 3：教室元件是由許多課桌椅元件所組成的，請參考如圖3-2。

圖 3‑2 教室元件

Step 4：請參考以下程式碼。

‘設定所有變數必須宣告才能使用
Option Explicit
‘宣告資料庫連結字串變數
Public strCnn As String
‘宣告資料庫連結物件
Public objCnn As ADODB.Connection
‘宣告年度字串變數
Public strLevel    As String
‘宣告學期字串變數
Public strLevelNo  As String
‘宣告班級字串變數
Public strUnit     As String
‘宣告地點字串變數
Public strPlace    As String
‘宣告名稱字串變數
Public strSchoolName As String
‘宣告重新整理事件
Event Refresh()
‘宣告讀出名稱屬性
Public Property Get SetSchoolName() As Variant
End Property
‘宣告設定名稱屬性
Public Property Let SetSchoolName(ByVal vNewValue As Variant)
    ‘設定新名稱
    strSchoolName = vNewValue
    ‘在標籤上顯示名稱
    labIB_Title(0).Caption = strSchoolName
End Property
‘宣告讀出年度屬性
Public Property Get SetLevel() As Variant
End Property
‘宣告設定年度屬性
Public Property Let SetLevel(ByVal vNewValue As Variant)
    ‘設定新年度
    strLevel = vNewValue
    ‘顯示新年度
    txtIB_Level.Text = strLevel
End Property
‘宣告讀出學期屬性
Public Property Get SetLevelNo() As Variant
End Property
‘宣告設定學期屬性
Public Property Let SetLevelNo(ByVal vNewValue As Variant)
    ‘設定新學期
    strLevelNo = vNewValue
    ‘顯示新學期
    txtIB_LevelNo.Text = strLevelNo
End Property
‘宣告讀出班級屬性
Public Property Get SetUnit() As Variant
End Property
‘宣告設定班級屬性
Public Property Let SetUnit(ByVal vNewValue As Variant)
    ‘設定新班級
    strUnit = vNewValue
    ‘顯示新班級
    txtIB_Unit.Text = strUnit
End Property
‘宣告讀出地點屬性
Public Property Get SetPlace() As Variant
End Property
‘宣告設定地點屬性
Public Property Let SetPlace(ByVal vNewValue As Variant)
    ‘設定新地點
    strPlace = vNewValue
    ‘顯示新地點
    txtIB_Place.Text = strPlace
End Property

‘左右調整桿數值有變動事件副程式
Private Sub hsbIB_Change()
    ‘呼叫左右位置調整副程式
    scrollform_Hsb
End Sub

‘上下調整桿數值有變動事件副程式
Private Sub vslIB_Change()
    ‘呼叫上下位置調整副程式
    scrollform_Vsl
End Sub

‘教室元件初始化事件副程式
Private Sub UserControl_Initialize()
    ‘設定課桌椅代碼
    uclItem_0101.SetItemID = “1-1”
    uclItem_0102.SetItemID = “1-2”
    uclItem_0103.SetItemID = “1-3”
    uclItem_0104.SetItemID = “1-4”
    uclItem_0105.SetItemID = “1-5”
    uclItem_0106.SetItemID = “1-6”
    uclItem_0107.SetItemID = “1-7”
    uclItem_0108.SetItemID = “1-8”
    uclItem_0109.SetItemID = “1-9”
    uclItem_0201.SetItemID = “2-1”
    uclItem_0202.SetItemID = “2-2”
    uclItem_0203.SetItemID = “2-3”
    uclItem_0204.SetItemID = “2-4”
    uclItem_0205.SetItemID = “2-5”
    uclItem_0206.SetItemID = “2-6”
    uclItem_0207.SetItemID = “2-7”
    uclItem_0208.SetItemID = “2-8”
    uclItem_0209.SetItemID = “2-9”
    uclItem_0301.SetItemID = “3-1”
    uclItem_0302.SetItemID = “3-2”
    uclItem_0303.SetItemID = “3-3”
    uclItem_0304.SetItemID = “3-4”
    uclItem_0305.SetItemID = “3-5”
    uclItem_0306.SetItemID = “3-6”
    uclItem_0307.SetItemID = “3-7”
    uclItem_0308.SetItemID = “3-8”
    uclItem_0309.SetItemID = “3-9”
    uclItem_0401.SetItemID = “4-1”
    uclItem_0402.SetItemID = “4-2”
    uclItem_0403.SetItemID = “4-3”
    uclItem_0404.SetItemID = “4-4”
    uclItem_0405.SetItemID = “4-5”
    uclItem_0406.SetItemID = “4-6”
    uclItem_0407.SetItemID = “4-7”
    uclItem_0408.SetItemID = “4-8”
    uclItem_0409.SetItemID = “4-9”
    uclItem_0501.SetItemID = “5-1”
    uclItem_0502.SetItemID = “5-2”
    uclItem_0503.SetItemID = “5-3”
    uclItem_0504.SetItemID = “5-4”
    uclItem_0505.SetItemID = “5-5”
    uclItem_0506.SetItemID = “5-6”
    uclItem_0507.SetItemID = “5-7”
    uclItem_0508.SetItemID = “5-8”
    uclItem_0509.SetItemID = “5-9”
    uclItem_0601.SetItemID = “6-1”
    uclItem_0602.SetItemID = “6-2”
    uclItem_0603.SetItemID = “6-3”
    uclItem_0604.SetItemID = “6-4”
    uclItem_0605.SetItemID = “6-5”
    uclItem_0606.SetItemID = “6-6”
    uclItem_0607.SetItemID = “6-7”
    uclItem_0608.SetItemID = “6-8”
    uclItem_0609.SetItemID = “6-9”
    uclItem_0701.SetItemID = “7-1”
    uclItem_0702.SetItemID = “7-2”
    uclItem_0703.SetItemID = “7-3”
    uclItem_0704.SetItemID = “7-4”
    uclItem_0705.SetItemID = “7-5”
    uclItem_0706.SetItemID = “7-6”
    uclItem_0707.SetItemID = “7-7”
    uclItem_0708.SetItemID = “7-8”
    uclItem_0709.SetItemID = “7-9”
    uclItem_0801.SetItemID = “8-1”
    uclItem_0802.SetItemID = “8-2”
    uclItem_0803.SetItemID = “8-3”
    uclItem_0804.SetItemID = “8-4”
    uclItem_0805.SetItemID = “8-5”
    uclItem_0806.SetItemID = “8-6”
    uclItem_0807.SetItemID = “8-7”
    uclItem_0808.SetItemID = “8-8”
    uclItem_0809.SetItemID = “8-9”
    ‘設定左右數值
    hsbIB.Value = 4475
    ‘呼叫資料庫建立連結副程式
    Call CnnDB_Create
End Sub

‘當教室元件關閉時
Private Sub UserControl_Terminate()
    ‘呼叫關閉資料庫副程式
    Call CnnDB_Close
End Sub

‘宣告左右位置調整桿副程式
Public Sub scrollform_Hsb()
    ‘宣告控制項物件
    Dim ctlControl As Control
    ‘巡覽在自訂控制項中的所有控制項
    For Each ctlControl In UserControl
        ‘讓電腦有時間處理其他事務
        DoEvents
        ‘當控制項的記號不等於NOSCROLL時
        If ctlControl.Tag <> “NOSCROLL” Then
           ‘則代表可以移動控制項的左右
           ctlControl.Left = ctlControl.Left + Val(labIB_HSB.Caption) – hsbIB.Value
        End If
    Next
    ‘透過隱藏的標籤紀錄移動的數值
    labIB_HSB.Caption = hsbIB.Value
End Sub

‘宣告上下位置調整桿副程式
Public Sub scrollform_Vsl()
    ‘宣告控制項物件
    Dim ctlControl As Control
    ‘巡覽在自訂控制項中的所有控制項
    For Each ctlControl In UserControl
        ‘讓電腦有時間處理其他事務
        DoEvents
        ‘當控制項的記號不等於NOSCROLL時
        If ctlControl.Tag <> “NOSCROLL” Then
           ‘則代表可以移動控制項的上下
           ctlControl.Top = ctlControl.Top + Val(labIB_VSL.Caption) – vslIB.Value
        End If
    Next
    ‘透過隱藏的標籤紀錄移動的數值
   labIB_VSL.Caption = vslIB.Value
End Sub

‘教室元件顯示事件副程式
Private Sub UserControl_Show()
    ‘設定左右調整桿的寬度及位置
    hsbIB.Top = UserControl.Height – hsbIB.Height
    hsbIB.Width = UserControl.Width
    ‘設定上下調整桿的高度及位置
    vslIB.Left = UserControl.Width – vslIB.Width
    vslIB.Height = UserControl.Height – hsbIB.Height
End Sub

‘宣告重新顯示事件副程式
Public Sub Refresh()
    ‘讓外部也可以使用此事件
    RaiseEvent Refresh
    ‘宣告控制項物件
    Dim ctlControl As Control
    ‘巡覽教室元件內所有控制項
    For Each ctlControl In UserControl
        ‘當控制項等於課桌椅元件時
        If TypeOf ctlControl Is uclItem Then
           ‘進行屬性設定
           ctlControl.SetLevel = txtIB_Level.Text
           ctlControl.SetLevelNo = txtIB_LevelNo.Text
           ctlControl.SetUnit = txtIB_Unit.Text
           ctlControl.SetPlace = txtIB_Place.Text
           ctlControl.SetCnnDB = objCnn
           ctlControl.Refresh
           ‘讓電腦有時間處理其他事務
           DoEvents
        End If
    Next
End Sub

‘建立資料庫連結副程式
Private Sub CnnDB_Create()
    ‘資料庫連結字串
    strCnn = “Provider=Microsoft.Jet.OLEDB.4.0;” & _
             “Data Source=” & App.Path & “\errorReport.mdb” & “;” & _
             “Mode=Read|Write|Share Deny None;” & _
             “Persist Security Info=False;”
    ‘建立資料庫連結物建
    Set objCnn = New ADODB.Connection
    ‘開啟資料庫
    objCnn.Open strCnn
End Sub

‘關閉資料庫副程式
Private Sub CnnDB_Close()
    ‘關閉資料庫
    objCnn.Close
    ‘釋放記憶體空間
    Set objCnn = Nothing
End Sub

我們來看看執行的情形，首先是程式起始畫面，這是依照需求者的要求設計，按鈕要很大。如圖3-3。

圖 3‑3 單位財產清點系統之程式起始畫面

接著我們來看需求者所要求的表單畫面，請參考如圖3-4。

圖 3‑4 單位財產清點系統之登錄、查詢、修改畫面

我們來看看統計及列印的功能畫面，如圖3-5。

圖 3‑5 單位財產清點系統之統計、列印畫面

現在是匯出成Excel檔案的過程，如圖3-6～3-8。

圖 3‑6 匯出完成訊息

圖 3‑7 依據班級匯出的Excel檔案

圖 3‑8 Excel檔案的內容

最後讓我們來看看有哪些設定，如圖3-9。

圖 3‑9 單位財產清點系統之設定畫面

3.7 修改重點¶

這支程式一開始就不應該採取需求者所提出的方式設計，因為他的需求只能滿足於他，沒辦法讓大眾接受。因此筆者就敘述應該設計的樣貌，讓讀者明瞭。首先，分析的觀點應是採取資料進出的流程，甚麼資料是要進入，甚麼資料是要被展現，資料是如何被處理，處理過程中有沒有特別要注意的地方。其次，介面問題，用甚麼樣的方式最能快速展現有問題單位財產，而非把沒有問題以及有問題的資料都全部顯示在一起，因為目的是要處理有問題的單位財產，所以沒有問題的資料列出來做甚麼用呢？浪費空間及時間而已。第三，功能切換的按鈕為什麼沒有一致性呢？好像零零散散的散落各地。如果能用工具列的方式或是選單的方式，不但感官的感受度也會比較好，而且讓其他使用者易懂流程，而不會只有需求者跟設計者兩個人知道而已。第四，既然要求要能匯出Excel的檔案，那為何不直接在Excel上做處理呢？這點筆者也搞不懂。最後，要重複顯示的資訊還算蠻多的，有必要嗎？例如：學年度、班級、…、等等。
這個元件設計的相當快速，不到一天就完成了，因此有點偷工減料，所謂偷工減料是採用直接對資料庫處理，比較好的做法應該是在記憶體上做處理，這樣才具備效率，因此建議讀者修改為在記憶體上處理，速度會增加十倍喔。
因此讀者只要能夠解決以上的問題，相信您修改後的程式會比較符合大眾口味，因為筆者是被逼著照表操課，但客戶卻很滿意，所以筆者認為這支程式的價值，在於解決特別需求的方法，供讀者參考。

3.8 結論¶

這支程式筆者一點也不想寫，但既然客戶滿意度相當高，因此才列出介紹給各位讀者，其實如果只是為了盤點教室財產，直接用試算表就可以了，例如Excel。不但可以紀錄，還可以統計分析，根本不需要特別寫一支程式來處理這件問題。
但話說回來，您是否也像筆者有時候遇到不可理喻的情況呢？相信是有的。身為軟體工人的我們，還是必須盡力達成需求者的要求，而且要想盡辦法用最簡單的方式趕快做完，這樣才能脫離苦海。元件是最快速的方式了，筆者只用了兩個元件就解決需求，其它的程式碼也只不過是對資料庫的存取動作罷了，最麻煩的就是使用者執意要求的操作介面一定要跟他設計的表單相同，因此我們只要找到他表單的同質性，抓住同質性將其設計成元件，重複使用，就輕易得達到他的要求，變成雙贏的局面。因此遇到問題或困難的時候，沒關係！動動腦！再加油！就OK啦！
多年後當我拿出這支程式給資訊業界的朋友看，大家都異口同聲的說：「這是甚麼東西阿！到底誰會用這軟體。」筆者只能苦笑的說：「怪人。」但無論如何還是解決了這位仁兄的需求，至少他在工作上能夠順順利利的也是一種幸福吧！

版權聲明¶

Lai Tai-Yu (賴岱佑)

回到教材說明