打开WORE的时候怎么修改他的菜单和工具栏，以及在点击菜单或工具条时，调用VB里的函数？

Question

打开WORE的时候怎么修改他的菜单和工具栏，以及在点击菜单或工具条时，调用VB里的函数？

Answer 1

Option Explicit
Private Sub Command1_Click()
    Dim i%, s$, xh$, cj$
    Dim p As Object, fs As Object, fld As Object
    Dim x As Object, xbook As Object, xsheet As Object
    Set fs = CreateObject("scripting.filesystemobject") '创建文件系统对象fs
    Set fld = fs.getfolder("c:\test")                    '创建文件系统对象的文件夹对象fld
    Set x = CreateObject("excel.application") '创建EXCEL应用程序对象，启动EXCEL应用程序
    Set xbook = x.workbooks.Add              '新建一个工作簿，并将其赋给xbook
    Set xsheet = xbook.worksheets(1)         '将xbook工作薄中的第一个表赋给xsheet
    x.Visible = True                         '让EXCEL可视
    xsheet.Columns("A:A").NumberFormatLocal = "@"       '将第A列文件格式设置成文本型
    xsheet.Cells(1, 1) = "学号"                         '为第一行第一列填入内容
    xsheet.Cells(1, 2) = "成绩"
    i = 2
    SendKeys "+{right}"                                 '模拟按键shift+right
    For Each p In fld.Files                   '遍历fld对象的所有files，并赋给变量p
        Open "c:\test\" & p.Name For Input As #1
        Do Until EOF(1)
            Line Input #1, s
            If Left(s, 4) = "学生考号" Then xh = Right(s, 8)
            If Left(s, 3) = "总得分" Then cj = Mid(s, 5)
        Loop
        Close #1
        xsheet.Cells(i, 1) = xh
        xsheet.Cells(i, 2) = cj
        SendKeys "+{down}"
        i = i + 1
    Next
    x.Visible = False
    If MsgBox("您想让我出来吗？", vbYesNo) = vbYes Then
        x.Visible = True
    Else
        x.Quit
        Set x = Nothing
    End If
End SubPrivate Sub Command2_Click()
    Dim i%, s$, xh$, cj$
    Dim p As Object, mytable As Object
    Dim fs As Object, fld As Object
    Dim x As Object, xdoc As Object
    Set fs = CreateObject("scripting.filesystemobject")
    Set fld = fs.getfolder("c:\test")
    Set x = CreateObject("word.application")
    Set xdoc = x.documents.Add
    x.Visible = True
    Set mytable = xdoc.Tables.Add(xdoc.Range, 1, 2)            '插入一个1行2列的表格
    mytable.Cell(1, 1).Range.InsertAfter "学号"                '为第1行第1列赋值
    mytable.Cell(1, 2).Range.InsertAfter "成绩"
    i = 2
    For Each p In fld.Files
        Open "c:\test\" & p.Name For Input As #1
        Do Until EOF(1)
            Line Input #1, s
            If Left(s, 4) = "学生考号" Then xh = Right(s, 8)
            If Left(s, 3) = "总得分" Then cj = Mid(s, 5)
        Loop
        Close #1
        mytable.Rows(mytable.Rows.Count).Select
        x.Selection.InsertRowsBelow 1
        mytable.Cell(i, 1).Range.InsertAfter xh
        mytable.Cell(i, 2).Range.InsertAfter Trim(cj)
        SendKeys "{down}"
        i = i + 1
    Next
End Sub