建立Excel模具管理系統(tǒng)菜單

管理系統(tǒng)都有一個(gè)菜單入口，VBA是excel中二次開發(fā)的語言，在WPS中如果沒有安裝高級(jí)版可能沒有VBA編程，在Excel中按鍵Alt+F11將進(jìn)入編程界面，或者在工作表右鍵點(diǎn)擊“查看代碼”也可以進(jìn)入。

步驟一、建立菜單的配置表

菜單表建立后，菜單即可按菜單，ID為不可重復(fù)的，F(xiàn)ID代表父級(jí)菜單，為父級(jí)菜單時(shí)，類型為10，是否分組代表有橫線的分組欄，執(zhí)行過程地址則為程序的入口。

步驟二：建立“附件工具.xla”主入口文件。文件的建立方法是新建的文件，在VBA編程界面中保存為.xla文件即可。
1、在左邊樹形中雙擊選擇ThisWorkbook對(duì)象，建立workbook.open的函數(shù)段，代碼如下：
Private Sub Workbook_Open()
Call mademenu
End Sub

2、點(diǎn)擊菜單插入模塊，模塊中寫入函數(shù)段如下：

Dim menulen As Integer
Dim menuobj() As Object
Dim menuid() As String

Sub mademenu()
Dim found, foundflag As Boolean
Dim cb, mybar, bar1, bar2, bar3
Dim file01, file02, filename01 As String
Dim myblank As Object
Dim i, k, tol As Integer
foundflag = False
file01 = Workbooks("附加工具.xla").path & "\" & "菜單配置.xls"
file02 = Workbooks("附加工具.xla").path & "\應(yīng)用程序\"
filename01 = "菜單配置.xls"
For Each cb In CommandBars
If cb.Name = "附加工具" Then
    cb.Visible = True
    cb.Delete
    Exit For
    End If
Next cb
If Not foundflag Then
    Set mybar = CommandBars.Add(Name:="附加工具", Position:=msoBarTop, temporary:=True)
    mybar.Visible = True
    menulen = 0
    found = False
    Application.ScreenUpdating = False
    If Not checkopen("菜單配置.xls") Then Workbooks.Open file01, ReadOnly:=True
    Application.Calculation = xlCalculationManual 
'    Workbooks(filename01).IsAddin = True//隱藏方式打開
    Workbooks(filename01).Activate
    Workbooks(filename01).Sheets("菜單表").Activate
    k = Workbooks(filename01).Sheets("菜單表").Cells(65536, "A").End(xlUp).Row
    ReDim menuobj(k)
    ReDim menuid(k)
    k = 4
    Do While Workbooks(filename01).Sheets("菜單表").Cells(k, "A") <> ""
        If Workbooks(filename01).Sheets("菜單表").Cells(k, "A") = Workbooks(filename01).Sheets("菜單表").Cells(k, "B") Then
        menulen = menulen + 1
        Set menuobj(menulen) = mybar.Controls.Add(Type:=msoControlPopup, temporary:=True)
            menuobj(menulen).Caption = "&" & asctocol(menuobj(menulen).Index) & " " & Workbooks(filename01).Sheets("菜單表").Cells(k, "C")
            menuobj(menulen).BeginGroup = IIf(UCase(Workbooks(filename01).Sheets("菜單表").Cells(k, "E")) = "TRUE", True, False)
            menuobj(menulen).Enabled = IIf(UCase(Workbooks(filename01).Sheets("菜單表").Cells(k, "F")) = "TRUE", True, False)
            menuid(menulen) = "A" & Workbooks(filename01).Sheets("菜單表").Cells(k, "A")
            Call addmenu(file02, Workbooks(filename01).Sheets("菜單表").Cells(k, "A"), k)
        End If
        k = k + 1
    Loop
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Workbooks("菜單配置.xls").Close False
Application.ScreenUpdating = True
End If
End Sub

3、建立遞歸子函數(shù)
Sub addmenu(file02, ByVal fid As String, ByVal k1 As Integer)
Dim i As Integer
Dim found As Boolean
Dim findobB As Object
Set findobB = Workbooks("菜單配置.xls").Sheets("菜單表").Columns("B").Find(fid, after:=Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1 - 1, "B"), lookat:=xlWhole, LookIn:=xlValues)
Do While Not findobB Is Nothing
    k1 = findobB.Row
    If Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "A") <> Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "B") Then
        found = False
        For i = menulen To 1 Step -1
            If menuid(i) = "A" & Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "B") Then
                found = True
                menulen = menulen + 1
                Set menuobj(menulen) = menuobj(i).Controls.Add(Type:=Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "D"), temporary:=True)
                menuobj(menulen).Caption = "&" & asctocol(menuobj(menulen).Index) & " " & Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "C")
                menuobj(menulen).BeginGroup = IIf(UCase(Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "E")) = "TRUE", True, False)
                menuobj(menulen).Enabled = IIf(UCase(Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "F")) = "TRUE", True, False)
                menuobj(menulen).OnAction = IIf(Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "G") <> "", file02 & Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "G"), "")
                menuid(menulen) = "A" & Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "A")
                Exit For
            End If
        Next i
        If Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "D") = "10" Then
            Call addmenu(file02, Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "A"), k1)
        End If
    End If
    Set findobB = Workbooks("菜單配置.xls").Sheets("菜單表").Columns("B").Find(fid, after:=Workbooks("菜單配置.xls").Sheets("菜單表").Cells(k1, "B"), lookat:=xlWhole, LookIn:=xlValues)
    If findobB.Row <= k1 Then Exit Do
Loop
End Sub

總結(jié)：本章節(jié)是建立菜單，后續(xù)的模具項(xiàng)目管理，模具BOM管理、以及報(bào)工管理將都采用該入口進(jìn)行點(diǎn)擊。

作者：江工

QQ：53757591