my first VBA 有新建菜单项、打开其它表并读内容等

麻雀虽小五脏俱全···呵呵`` 主要实现从其它表读取内容生成一个汇总表 

Private Sub AddData()
    Dim FileName As Variant
    Dim xlBook As Workbook
    Dim xlApp As Application
    Dim xlSheet As Worksheet
    Dim tmp_filename As String
    Dim tmp_str As String
    Dim tmp_proname As String
    Dim tmp_type As String
    Dim tmp_s As String
    Dim tmp_flag As String
    Dim isContain As Boolean
    Set xlApp = New Excel.Application
   
    Dim tmp_n As Integer
   
     '打开文件对话框返回的文件名，是一个全路径文件名，其值也可能是False，因此类型为Variant
    Dim ws As Worksheet                             '存储文件路径名和文件名的工作表
    Set ws = Worksheets(2)                          '设置工作表
   
    On Error GoTo ERROR1
    FileName = Application.GetOpenFilename("Excel 文件 (*.xls),*.xls", MultiSelect:=True)
    tmp_n = Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row + 1 '最后一行
   
   
    If tmp_n Mod 2 <> 0 Then
        tmp_n = tmp_n + 1
    End If
   
    If IsArray(FileName) Then
        For n = 1 To UBound(FileName)
            tmp_filename = FileName(n)
            Set xlBook = xlApp.Workbooks.Open(tmp_filename)
            Set xlSheet = xlBook.Worksheets("表一")
            tmp_str = Trim(Mid(xlSheet.Cells(4, 1), 6))
            tmp_proname = Left(tmp_str, Len(tmp_str) - 6)
            tmp_type = Right(tmp_str, 6)
           
            '先遍历有没有这个项目的数据
            tmp_flag = tmp_n
            isContain = False
            For m = 4 To tmp_n Step 2
                If (ws.Cells(m, 3) = tmp_proname) Then
                    tmp_flag = m
                    isContain = True
                    Exit For
                End If
            Next
           
            If isContain Then
                '有的话更新
                For j = 1 To Len(tmp_type)
                    If Mid(tmp_type, j, 2) = "设备" Then
                        tmp_flag = tmp_flag + 1
                    End If
                Next
               
                If tmp_flag Mod 2 = 0 Then
                    ws.Cells(tmp_flag, 3).Value = tmp_proname
                Else
                    ws.Cells(tmp_flag - 1, 3).Value = tmp_proname
                End If
               
                ws.Cells(tmp_flag, 19).Value = xlSheet.Cells(10, 5)
                ws.Cells(tmp_flag, 20) = xlSheet.Cells(9, 7)
           
                Set xlSheet = xlBook.Worksheets("表二")
                ws.Cells(tmp_flag, 22) = xlSheet.Cells(13, 4)
           
                Set xlSheet = xlBook.Worksheets("表五(甲)")
                ws.Cells(tmp_flag, 24) = xlSheet.Cells(8, 6)
                ws.Cells(tmp_flag, 26) = xlSheet.Cells(11, 6)
                ws.Cells(tmp_flag, 27) = xlSheet.Cells(14, 6)
                ws.Cells(tmp_flag, 28) = xlSheet.Cells(15, 6)
                ws.Cells(tmp_flag, 29) = xlSheet.Cells(20, 6)
                ws.Cells(tmp_flag, 30) = xlSheet.Cells(21, 6)
            Else
                '没有的话在后面添加
                Range(Cells(tmp_flag, 3), Cells(tmp_flag + 1, 3)).Merge '合并单元格
                For j = 1 To Len(tmp_type)
                    If Mid(tmp_type, j, 2) = "设备" Then
                        tmp_flag = tmp_flag + 1
                    End If
                Next
               
                If tmp_flag Mod 2 = 0 Then
                    ws.Cells(tmp_flag, 3).Value = tmp_proname
                Else
                    ws.Cells(tmp_flag - 1, 3).Value = tmp_proname
                End If
               
                ws.Cells(tmp_flag, 19).Value = xlSheet.Cells(10, 5)
                ws.Cells(tmp_flag, 20) = xlSheet.Cells(9, 7)
           
                Set xlSheet = xlBook.Worksheets("表二")
                ws.Cells(tmp_flag, 22) = xlSheet.Cells(13, 4)
           
                Set xlSheet = xlBook.Worksheets("表五(甲)")
                ws.Cells(tmp_flag, 24) = xlSheet.Cells(8, 6)
                ws.Cells(tmp_flag, 26) = xlSheet.Cells(11, 6)
                ws.Cells(tmp_flag, 27) = xlSheet.Cells(14, 6)
                ws.Cells(tmp_flag, 28) = xlSheet.Cells(15, 6)
                ws.Cells(tmp_flag, 29) = xlSheet.Cells(20, 6)
                ws.Cells(tmp_flag, 30) = xlSheet.Cells(21, 6)
                tmp_n = tmp_n + 2
            End If
            xlBook.Close SaveChanges:=False
        Next
    End If
    Exit Sub
ERROR1:
    MsgBox (tmp_filename & "  文件格式不正确!")
End Sub

 

Public Sub 预算()
    Dim HelpMenu As CommandBarControl
    Dim NewMenu As CommandBarPopup
    Dim MenuItem As CommandBarControl
    Dim SubMenuItem As CommandBarButton
   
    On Error Resume Next
    '如果菜单已存在,则删除该菜单
    CommandBars(1).Controls("预算(&S)").Delete
   
    '利用ID属性查找帮助菜单
    Set HelpMenu = CommandBars(1).FindControl(ID:=30010)
   
    If HelpMenu Is Nothing Then
        '如果该菜单不存在,则将新菜单添加到末尾
        '设置新菜单为临时的
        Set NewMenu = CommandBars(1).Controls _
          .add(Type:=msoControlPopup, Temporary:=True)
    Else
        '将新菜单添加到帮助菜单之前
        Set NewMenu = CommandBars(1).Controls _
          .add(Type:=msoControlPopup, Before:=HelpMenu.Index, _
          Temporary:=True)
    End If
   
    '添加菜单标题并指定热键
    NewMenu.Caption = "预算(&S)"
   
    '添加第一个菜单项
    Set MenuItem = NewMenu.Controls.add _
      (Type:=msoControlButton)
    With MenuItem
        .Caption = "数据(&D)..."
        .FaceId = 162
        .OnAction = "AddData"
    End With
End Sub