醫療裝置固定資產管理，VBA程式設計方法

No.1

裝置管理在任何企業都是必要的一個環節，最近有一些比較多的需求，關於裝置管理這一方面的應用，似乎用得比較多。

本節介紹一個醫院的醫療裝置管理應用。

下圖為記錄表和操作頁面：

管理功能，有裝置資訊輸入，裝置狀態修改，和裝置統計，裝置搜尋。

其實這些固定的內容，還是比較管理的，完全是一些表格進行整理和統計，最終出來一個結果。

下圖為裝置狀態管理：

狀態管理也就是裝置的應用報廢等操作。

裝置統計這塊完成起來比較複雜，雖然看上去只有幾個資料，但是越是簡單的東西，背後的複雜程式越高，不太好解釋，反正後面的程式碼很多，而且巢狀也有三層。

裝置資訊登記，相對簡單，全做了文字框需要一一錄入，似乎很不友好，但是看上去很清爽。

No.2

裝置統計程式碼

Dim sName(), xCol(), sN As Variant, li As Integer, lobj As ObjectsName = Array("裝置名稱", "使用科室", "裝置狀態")xCol = Array("B", "I", "T")For Each sN In sNameSet lobj = Me.Controls.Add("Forms.Frame.1", sN)With lobj.Top = 60.Width = 300.Left = li * (.Width + 5) + 50.Height = 450.Caption = sN' .ScrollBars = 3End WithsetFont lobjSet lobj = GetListObject(lobj)Call showCellList(getListCells((xCol(li))), lobj)li = li + 1Next sN

顯示列表

Private Function showCellList(cellsList As Range, lobj As Object) '顯示列表Dim xR As Range, xArr(), xa As Variant, x As Integer, isTrue As Boolean, xCount() As LongReDim xArr(0)ReDim xCount(0)For Each xR In cellsListisTrue = FalseFor Each xa In xArrIf VBA.CVar(xR.Value) = xa ThenisTrue = TrueExit ForEnd IfNext xaIf Not isTrue ThenReDim Preserve xArr(x)ReDim Preserve xCount(x)xArr(x) = xR.ValuexCount(x) = getXrCount(xArr(x), cellsList) '返回統計數量AddNewInfoLists xArr(x), xCount(x), lobj ''新建資訊x = x + 1End IfNext xRshowCellList = xArrEnd Function

上述程式碼中還應用了兩個函數getXrCount()和AddNewinfoLists()分別實現具體新增ListBox列表內容功能。

Private Sub AddNewInfoList(LabelName As Variant, LabelCount As Long, lobj As Object)Dim xObj As Object, Robj As ObjectSet xObj = lobj.Add("Forms.Label.1", "Lx" & LabelCount)With xObj.Height = 25.Top = (lobj.Controls.Count 2) * .Height + 20.Left = 20.Width = lobj.Width * 0.65.Caption = LabelNameEnd WithSet Robj = lobj.Add("Forms.Label.1", "Lo" & LabelCount)With Robj.Height = xObj.Height.Top = xObj.Top.Left = xObj.Left + xObj.Width + 20.Width = lobj.Width * 0.2.Caption = LabelCountEnd WithSet xObj = NothingSet Robj = NothingEnd Sub

整體來說，通過對錶格處理，可實現的想要完成功能是一件很簡單的事情，但這個簡單的事情背後，有一些艱難的過程需要處理，這就是程式設計的工作所在。

投入應用之後，也會發生一些問題，那就需要不斷地進行修改。

所以，沒有完美的結果，只有更理想的結果。

歡迎關注、收藏

---END---