vba｜綜合應用程式設計（從設計功能區到相關控制項代碼）

本文以設計一個進銷存管理系統為例來說明如何通過VBA二次開發一個Excel應用程式。

進銷存管理系統主要包括進貨、銷售、庫存和資料管理等模組， 如下圖所示：

針對上面的模組的相應功能， 可以通過輸入、輸出使用者表單或工作表作來使用者介面來實現。

功能區可以通過使用XML代碼進行精細設置。

3.1 新建一個專案檔案夾， 可以命名為“進銷存管理系統”；

3.2 將之前設計的“進銷存管理.xlsm"工作表保存到專案檔案夾內；

3.3 在專案檔案夾內新建一個“customUI”資料夾；

3.4 在“customUI”資料夾內新建“customUI.xml"檔， 內容如下：

‘↓禁止功能區“檔”中的部分功能表功能

’↓隱藏功能區9個內置選項卡

‘↓創建新選項卡

size="large" label="錄入" onAction="btIN_INPUT_onAction"/>

size="large" label="報表" onAction="btIN_REPORT_onAction"/>

size="large" label="錄入" onAction="btOUT_INPUT_onAction"/>

size="large" label="報表" onAction="btOUT_REPORT_onAction"/>

size="large" label="銷售業績" onAction="btOUT_RESULTS_onAction"/>

size="large" label="存貨查詢" onAction="btSTOCK_FIND_onAction"/>

size="large" label="存貨統計" onAction="btSTOCK_SUM_onAction"/>

size="large" label="庫存明細" onAction="btSTOCK_DETAILS_onAction"/>

size="large" label="商品資訊" onAction="btDATA_COMM_onAction"/>

size="large" label="銷售人員" onAction="btDATA_SALES_onAction"/>

3.5 將Excel工作薄變成一個壓縮檔檔：將“進銷存管理.xlsm"重命名為“進銷存管理.xlsm.zip"即可。

3.6 添加資料夾“customUI”到壓縮檔“進銷存管理.xlsm.zip"：拖入即可， 如下圖所示：

3.7 在工作簿文件與xml文件建立關係：

在壓縮檔的_rels資料夾內的.rles檔中添加以下內容（添加到最後一個Relationship標記前）：

Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml"/>

3.8 保存並關閉.rles文件；

3.9 將壓縮檔改回到工作簿：將“進銷存管理.xlsm.zip"重命名為“進銷存管理.xlsm"即可。

3.10 打開“進銷存管理.xlsm”， 即可看到如下自訂選項卡的工作介面：

2 設計功能區各按鈕代碼

2.1 按快速鍵Alt+F11打開VBE環境；

2.2 增加一個標準模組：插入→模組；

2.3 定義一個全域變數：

Option Explicit

Public Const AppName As String = "進銷存管理系統"

2.4 “進貨”組中有兩個按鈕， 用來操作進貨錄入和進化報表兩個功能，

具體的代碼如下：

Sub btIN_INPUT_onAction(Control As IRibbonControl) '進貨錄入

Sheets("供貨單").Select '選擇"供貨單"工作表

Range("b5").Select '選擇B5儲存格

End Sub

Sub btIN_REPORT_onAction(Control As IRibbonControl) '進貨報報

Sheets("進貨報表").Select '選擇"進貨報表"工作表

Range("C2").Select '選擇C2儲存格

End Sub

其它模組的按鈕的代碼按上述思想同樣設置。

3 輸入介面資料保存到工作表的代碼設計

在“進貨”模組， 可以使用工作表“供貨單”錄入進貨資料， 錄入的資料保存到“供貨”工作表中。

3.1 設計“供貨單”工作表

此輸入介面可以是使用者表單， 也可以是工作表。

3.2 設計“保存”代碼

當使用者輸入好供應商品資訊後， 按一下“保存”控制項即可將輸入的資料保存到“供貨”工作表中， 代碼如下：

Sub 保存供貨資訊()

Dim x As Integer, i As Integer, j As Integer

Call 手動計算

With Sheets("供貨")

.Unprotect Password:="wyg"

x = 2 '從第2行開始

'判斷第2列的最後一行(即空行的上一行)

Do While Not (IsEmpty(.Cells(x, 2).Value))

x = x + 1 '在最後一行加一行即為空行

Loop

End With

With Sheets("供貨單")

For i = 1 To 8

If Not IsEmpty(.Cells(5 + i, 2)) Then

Sheets("供貨").Cells(x, 1) = .Cells(3, 9) '時間

Sheets("供貨").Cells(x, 1).NumberFormatLocal = "yyyy-m-d h:mm;@"

Sheets("供貨").Cells(x, 11) = .Cells(3, 3) '供應商

For j = 2 To 10

Sheets("供貨").Cells(x, j) = .Cells(5 + i, j)

Next j

x = x + 1

End If

Next i

'清除供貨單中的資料

.Range("b6:b13") = ""

.Range("i6:i13") = ""

.Select

End With

Call 自動計算

With Sheets("供貨").Range("A1").CurrentRegion

.Borders.LineStyle = xlContinuous

.Borders.Weight = xlThin

End With

Sheets("供貨").Protect Password:="wyg"

End Sub

其它模組的保存的相應代碼可以按上述思想分別設置。

4 報表輸出代碼設計

當用戶在功能區“進銷存”選項卡的“進貨”組中， 按一下“報表”按鈕時， 將顯示進貨報表。 在該報表中由使用者輸入統計的起止日期， 程式將按時間段統計所有進貨的情況， 生成進貨報表。

為“生成報表”按鈕指定巨集，並編寫巨集代碼如下：

Sub 進貨報表()

Dim datStart As Date, datEnd As Date

If IsDate(Cells(2, 3)) Then

datStart = DateValue(Cells(2, 3))

Else

MsgBox "日期輸入錯誤"

Exit Sub

End If

If IsDate(Cells(2, 5)) Then

datEnd = DateValue(Cells(2, 5))

Else

MsgBox "日期輸入錯誤"

Exit Sub

End If

If datStart > datEnd Then

MsgBox "起始日期應小於或等於結束日期"

Else

生成進貨報表

End If

End Sub

Sub 生成進貨報表()

Dim x As Integer, j As Integer, rngTemp As Range

Dim intRow As Integer

Sheets("供貨").Unprotect Password:="wyg"

Set rngTemp = Sheets("供貨").Range("A2").CurrentRegion

rngTemp.Sort Key1:=Sheets("供貨").Range("A2"), Order1:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

SortMethod:=xlPinYin, DataOption1:=xlSortNormal

Sheets("供貨").Protect Password:="wyg"

With Sheets("進貨報表")

.Activate

.Unprotect Password:="wyg"

intRow = .Range("A4").CurrentRegion.Rows.Count

.Range(.Cells(5, 1), .Cells(intRow + 4, 10)).EntireRow.Delete

.Range("A5").Select

x = 2

j = 5

Do While Not (IsEmpty(Sheets("供貨").Cells(x, 2).Value))

If DateValue(Sheets("供貨").Cells(x, 1)) >= DateValue(.Cells(2, 3)) And _

DateValue(Sheets("供貨").Cells(x, 1)) <= DateValue(.Cells(2, 5)) Then

.Cells(j, 1).NumberFormatLocal = "yyyy-m-d h:mm;@"

.Cells(j, 1) = Sheets("供貨").Cells(x, 1) '日期

.Cells(j, 2) = Sheets("供貨").Cells(x, 2) '貨號

.Cells(j, 3) = Sheets("供貨").Cells(x, 3) '名稱

.Cells(j, 4) = Sheets("供貨").Cells(x, 4) '型號

.Cells(j, 5) = Sheets("供貨").Cells(x, 5) '產地

.Cells(j, 6) = Sheets("供貨").Cells(x, 9) '數量

.Cells(j, 7).NumberFormatLocal = "#,##0.00_ "

.Cells(j, 7) = Sheets("供貨").Cells(x, 6) '進價

.Cells(j, 8).NumberFormatLocal = "#,##0.00_ "

.Cells(j, 8) = .Cells(j, 6) * .Cells(j, 7) '金額

.Cells(j, 9).NumberFormatLocal = "#,##0.00_ "

.Cells(j, 9) = Sheets("供貨").Cells(j, 7) '批發價

.Cells(j, 10).NumberFormatLocal = "#,##0.00_ "

.Cells(j, 10) = Sheets("供貨").Cells(j, 8) '零售價

j = j + 1

End If

x = x + 1

Loop

.Cells(j, 1) = "合計"

.Cells(j, 8).NumberFormatLocal = "#,##0.00_ "

.Cells(j, 8).FormulaR1C1 = "=SUM(R[" & 5 - j & "]C:R[-1]C)"

.Range(.Cells(5, 1), .Cells(j, 10)).Select

設置邊框

' .Select

.Range("A5").Select

.Protect Password:="wyg"

End With

End Sub

其它模組的報表的相應代碼可以按上述思想分別設置。

－End－

為“生成報表”按鈕指定巨集，並編寫巨集代碼如下：

Sub 進貨報表()

Dim datStart As Date, datEnd As Date

If IsDate(Cells(2, 3)) Then

datStart = DateValue(Cells(2, 3))

Else

MsgBox "日期輸入錯誤"

Exit Sub

End If

If IsDate(Cells(2, 5)) Then

datEnd = DateValue(Cells(2, 5))

Else

MsgBox "日期輸入錯誤"

Exit Sub

End If

If datStart > datEnd Then

MsgBox "起始日期應小於或等於結束日期"

Else

生成進貨報表

End If

End Sub

Sub 生成進貨報表()

Dim x As Integer, j As Integer, rngTemp As Range

Dim intRow As Integer

Sheets("供貨").Unprotect Password:="wyg"

Set rngTemp = Sheets("供貨").Range("A2").CurrentRegion

rngTemp.Sort Key1:=Sheets("供貨").Range("A2"), Order1:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

SortMethod:=xlPinYin, DataOption1:=xlSortNormal

Sheets("供貨").Protect Password:="wyg"

With Sheets("進貨報表")

.Activate

.Unprotect Password:="wyg"

intRow = .Range("A4").CurrentRegion.Rows.Count

.Range(.Cells(5, 1), .Cells(intRow + 4, 10)).EntireRow.Delete

.Range("A5").Select

x = 2

j = 5

Do While Not (IsEmpty(Sheets("供貨").Cells(x, 2).Value))

If DateValue(Sheets("供貨").Cells(x, 1)) >= DateValue(.Cells(2, 3)) And _

DateValue(Sheets("供貨").Cells(x, 1)) <= DateValue(.Cells(2, 5)) Then

.Cells(j, 1).NumberFormatLocal = "yyyy-m-d h:mm;@"

.Cells(j, 1) = Sheets("供貨").Cells(x, 1) '日期

.Cells(j, 2) = Sheets("供貨").Cells(x, 2) '貨號

.Cells(j, 3) = Sheets("供貨").Cells(x, 3) '名稱

.Cells(j, 4) = Sheets("供貨").Cells(x, 4) '型號

.Cells(j, 5) = Sheets("供貨").Cells(x, 5) '產地

.Cells(j, 6) = Sheets("供貨").Cells(x, 9) '數量

.Cells(j, 7).NumberFormatLocal = "#,##0.00_ "

.Cells(j, 7) = Sheets("供貨").Cells(x, 6) '進價

.Cells(j, 8).NumberFormatLocal = "#,##0.00_ "

.Cells(j, 8) = .Cells(j, 6) * .Cells(j, 7) '金額

.Cells(j, 9).NumberFormatLocal = "#,##0.00_ "

.Cells(j, 9) = Sheets("供貨").Cells(j, 7) '批發價

.Cells(j, 10).NumberFormatLocal = "#,##0.00_ "

.Cells(j, 10) = Sheets("供貨").Cells(j, 8) '零售價

j = j + 1

End If

x = x + 1

Loop

.Cells(j, 1) = "合計"

.Cells(j, 8).NumberFormatLocal = "#,##0.00_ "

.Cells(j, 8).FormulaR1C1 = "=SUM(R[" & 5 - j & "]C:R[-1]C)"

.Range(.Cells(5, 1), .Cells(j, 10)).Select

設置邊框

' .Select

.Range("A5").Select

.Protect Password:="wyg"

End With

End Sub

其它模組的報表的相應代碼可以按上述思想分別設置。

－End－