云易云模具管理软件

提供全面的管理思路!

当前位置: 首页
> 管理课堂
> 模具ERP/MES >excel进行模具管理之VBA编程 标签:模具管理,BOM管理,员工绩效
产品分类
  • 销售管理
  • 项目管理
  • 工艺管理
  • 设计管理
  • 模具管理
  • 生产管理
  • 仓库管理
  • 采购/委外管理
  • 质量管理
  • 热门管理课堂
  • 模具erp系统介绍
  • 模具企业生产ERP/MES管理系统软件解决方案
  • 模具管理软件MES制造执行系统
  • 生产企业MES管理软件系统详解
  • excel进行模具管理之VBA编程
  • 模具仓库管理体系的三个层次
  • 模具厂ERP管理软件概述
  • ERP管理系统实现最低量的库存与最快速的周转
  • 自动智能排程APS软件系统高级计划和排程的价值
  • 模具运作流程与软件的必要性
  • 影响模具生产成本的要素
  • 库存积压、物料混乱、人工盘点,你的仓库管理为什么那么累?
  • 模具与零件数控加工的切削刀具
  • 模具生产管理之员工绩效及薪资计算
  • 如何选择APS排程进行生产计划管理?
  • 如何才能做好生产计划,物控工作,PMC/生管部门流程与岗位职责;...
  • 模具ERP、MES、APS排程几种信息管理软件系统集成简述
  • 模具管理系统中加工工艺简述
  • excel进行模具管理数据库编程
  • 模具设备保养与维护维修方法方案
  • 热门功能
  • 模具厂自动智能排程APS软件系统怎么排?
  • 模具MES的生产报工方式
  • ERP软件系统中订单管理怎么操作跟踪?
  • 模具ERP/MES中项目管理的操作方法
  • 模具BOM管理软件的导入与BOM申购管理
  • 模具ERP软件中物料产品配置系统是怎么使用?
  • 模具库存物料条码管理系统、物料管理模块软件
  • 模具行业加工生产过程零件进度报表
  • 零件委外、设计委外、生产工序委外外协、外协供应链管理系统
  • excel进行模具管理之VBA编程

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

    建立Excel模具管理系统菜单

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

    VBA图1.jpg

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

    VBA图2.jpg

    菜单表建立后,菜单即可按菜单,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

    返回
    模具管理软件QQ咨询 联系云易云微信
    模具项目管理在线留言 在线留言
    ERP即时沟通
    返回顶部