300字范文,内容丰富有趣,生活中的好帮手!
300字范文 > excel进行模具管理之VBA菜单编程

excel进行模具管理之VBA菜单编程

时间:2021-02-07 20:48:15

相关推荐

excel进行模具管理之VBA菜单编程

建立Excel模具管理系统菜单

管理系统都有一个菜单入口,VBA是excel中二次开发的语言,在WPS中如果没有安装高级版可能没有VBA编程,在Excel中按键Alt+F11将进入编程界面,或者在工作表右键点击“查看代码”也可以进入。

步骤一、建立菜单的配置表

菜单表建立后,菜单即可按菜单,ID为不可重复的,FID代表父级菜单,为父级菜单时,类型为10,是否分组代表有横线的分组栏,执行过程地址则为程序的入口。

步骤二:建立“附件工具.xla”主入口文件。文件的建立方法是新建的文件,在VBA编程界面中保存为.xla文件即可。

1、在左边树形中双击选择ThisWorkbook对象,建立workbook.open的函数段,代码如下:

Private Sub Workbook_Open()

Call mademenu

End Sub

2、点击菜单插入模块,模块中写入函数段如下:

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 & "\应用程序\"

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、建立递归子函数

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

总结:本章节是建立菜单,后续的模具项目管理,模具BOM管理、以及报工管理将都采用该入口进行点击。

作者:江工

QQ:53757591

本内容不代表本网观点和政治立场,如有侵犯你的权益请联系我们处理。
网友评论
网友评论仅供其表达个人看法,并不表明网站立场。