第一篇：VB操作word总结
请耐心看完：问题出现得较复杂。
我的目的：
将多个文档内容逐一拷贝粘贴到另一文档后面
我的方法：
wordapp=new word.application
Set doc = wordapp.Documents.Add
while
pathTemp = App.Path & “temp.doc”
LoadFile rs(“word”), pathTemp
Set doctemp = wordapp.Documents.Open(pathTemp)
doctemp.Content.Select
wordapp.Selection.copy
Set myRange = doc.Range(Start:=doc.Content.End 缺少参数 3文件不存在 ' '*************************************************************** Public Function ReplacePic(FindStr As String, Optional Time As Integer = 0)As Integer Attribute ReplacePic.VB_Description = “查找FindStr,并替换为PicFile所指向的图片文件,替换次数由time参数确定,为0时，替换所有” '******************************************************************************** '
从Word.Range对象mysel中查找所有FindStr，并替换为PicFile图像 ' 替换次数由time参数确定，为0时，替换所有
'******************************************************************************** If Len(C_PicFile)= 0 Then C_ErrMsg = 2 Exit Function End If Dim i As Integer Dim findtxt As Boolean mysel.Find.ClearFormatting mysel.Find.Replacement.ClearFormatting With mysel.Find.Text = FindStr.Replacement.Text = “".Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = False End With mysel.HomeKey Unit:=wdStory findtxt = mysel.Find.Execute(Replace:=True)If Not findtxt Then ReplacePic = 0 Exit Function End If i = 1 Do While findtxt mysel.InlineShapes.AddPicture FileName:=C_PicFile If i = Time Then Exit Do i = i + 1 mysel.HomeKey Unit:=wdStory findtxt = mysel.Find.Execute(Replace:=True)Loop ReplacePic = i End Function Public Function FindThis(FindStr As String)As Boolean Attribute FindThis.VB_Description = ”查找FindStr,如果模板中有FindStr则返回True“ If Len(FindStr)= 0 Then C_ErrMsg = 2 Exit Function End If mysel.Find.ClearFormatting mysel.Find.Replacement.ClearFormatting With mysel.Find.Text = FindStr.Replacement.Text = ”“.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = False End With mysel.HomeKey Unit:=wdStory FindThis = mysel.Find.Execute End Function Public Function ReplaceChar(FindStr As String, RepStr As String, Optional Time As Integer = 0)As Integer Attribute ReplaceChar.VB_Description = ”查找FindStr,并替换为RepStr,替换次数由time参数确定,为0时，替换所有“ '******************************************************************************** '
从Word.Range对象mysel中查找FindStr，并替换为RepStr ' 替换次数由time参数确定，为0时，替换所有
'******************************************************************************** Dim findtxt As Boolean If Len(FindStr)= 0 Then C_ErrMsg = 2 RaiseEvent HaveError Exit Function End If mysel.Find.ClearFormatting mysel.Find.Replacement.ClearFormatting With mysel.Find.Text = FindStr.Replacement.Text = RepStr.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = False End With
If Time > 0 Then For i = 1 To Time mysel.HomeKey Unit:=wdStory findtxt = mysel.Find.Execute(Replace:=wdReplaceOne)If Not findtxt Then Exit For Next If i = 1 And Not findtxt Then ReplaceChar = 0 Else ReplaceChar = i End If Else mysel.Find.Execute Replace:=wdReplaceAll End If End Function
Public Function GetPic(PicData()As Byte, FileName As String)As Boolean Attribute GetPic.VB_Description = ”把图像数据PicData,存为PicFile指定的文件“ '******************************************************************************** '
把图像数据PicData,存为PicFile指定的文件
'******************************************************************************** On Error Resume Next If Len(FileName)= 0 Then C_ErrMsg = 2 RaiseEvent HaveError Exit Function End If Open FileName For Binary As #1 If Err.Number <> 0 Then C_ErrMsg = 3 Exit Function End If '二进制文件用Get,Put存放，读取数据 Put #1, , PicData Close #1 C_PicFile = FileName GetPic = True End Function
Public Sub DeleteToEnd()Attribute DeleteToEnd.VB_Description = ”删除从当前位置到结尾的所有内容“ mysel.EndKey Unit:=wdStory, Extend:=wdExtend mysel.Delete Unit:=wdCharacter, Count:=1 End Sub Public Sub MoveEnd()Attribute MoveEnd.VB_Description = ”光标移动到文档结尾“ '光标移动到文档结尾 mysel.EndKey Unit:=wdStory End Sub Public Sub GotoLine(LineTime As Integer)mysel.GoTo What:=wdGoToLine, Which:=wdGoToFirst, Count:=LineTime, Name:=”“ End Sub Public Sub OpenDoc(view As Boolean)Attribute OpenDoc.VB_Description = ”打开Word文件,View确定是否显示Word界面“ On Error Resume Next '******************************************************************************** '
打开Word文件，并给全局变量mysel赋值
'******************************************************************************** If Len(C_TemplateDoc)= 0 Then mywdapp.Documents.Add Else mywdapp.Documents.Open(C_TemplateDoc)End If If Err.Number <> 0 Then C_ErrMsg = 4 RaiseEvent HaveError Exit Sub End If
mywdapp.Visible = view mywdapp.Activate Set mysel = mywdapp.Application.Selection 'mysel.Select
End Sub Public Sub OpenWord()On Error Resume Next '******************************************************************************** '
打开Word程序，并给全局变量mywdapp赋值
'******************************************************************************** Set mywdapp = CreateObject(”word.application“)If Err.Number <> 0 Then C_ErrMsg = 1 RaiseEvent HaveError Exit Sub End If End Sub Public Sub ViewDoc()Attribute ViewDoc.VB_Description = ”显示Word程序界面“ mywdapp.Visible = True End Sub Public Sub AddNewPage()Attribute AddNewPage.VB_Description = ”插入分页符“ mysel.InsertBreak Type:=wdPageBreak End Sub Public Sub WordCut()Attribute WordCut.VB_Description = ”剪切模板所有内容到剪切板“ '保存模板页面内容 mysel.WholeStory mysel.Cut mysel.HomeKey Unit:=wdStory End Sub Public Sub WordCopy()Attribute WordCopy.VB_Description = ”拷贝模板所有内容到剪切板“ mysel.WholeStory mysel.Copy mysel.HomeKey Unit:=wdStory End Sub Public Sub WordDel()mysel.WholeStory mysel.Delete mysel.HomeKey Unit:=wdStory End Sub Public Sub WordPaste()Attribute WordPaste.VB_Description = ”拷贝剪切板内容到当前位置“ '插入模块内容 mysel.Paste End Sub Public Sub CloseDoc()Attribute CloseDoc.VB_Description = ”关闭Word文件模板“ '******************************************************************************** '
关闭Word文件模本 '******************************************************************************** On Error Resume Next
mywdapp.ActiveDocument.Close False If Err.Number <> 0 Then C_ErrMsg = 3 Exit Sub End If End Sub Public Sub QuitWord()'******************************************************************************** '
关闭Word程序
'******************************************************************************** On Error Resume Next mywdapp.Quit
If Err.Number <> 0 Then C_ErrMsg = 3 Exit Sub End If End Sub Public Sub SavetoDoc()Attribute SavetoDoc.VB_Description = ”保存当前文档为FileName指定文件“ On Error Resume Next '并另存为文件FileName If Len(C_newDoc)= 0 Then C_ErrMsg = 2 RaiseEvent HaveError Exit Sub End If mywdapp.ActiveDocument.SaveAs(C_newDoc)
If Err.Number <> 0 Then C_ErrMsg = 3 RaiseEvent HaveError Exit Sub End If End Sub
Public Property Get TemplateDoc()As String Attribute TemplateDoc.VB_Description = ”模板文件名.“ TemplateDoc = C_TemplateDoc End Property Public Property Let TemplateDoc(ByVal vNewValue As String)C_TemplateDoc = vNewValue End Property Public Property Get newdoc()As String Attribute newdoc.VB_Description = ”执行CloseDoc方法时，将模板文件另存为此文件名指定的新文件.如果不指定，在执行CloseDoc方法时，将产生一个错误“ newdoc = C_newDoc End Property Public Property Let newdoc(ByVal vNewValue As String)C_newDoc = vNewValue End Property Public Property Get PicFile()As String Attribute PicFile.VB_Description = ”图像文件名“ PicFile = C_PicFile End Property Public Property Let PicFile(ByVal vNewValue As String)C_PicFile = vNewValue End Property Public Property Get ErrMsg()As Integer Attribute ErrMsg.VB_Description = ”错误信息.ErrMsg代码: 1-word没有安装 2-缺少参数 3-没权限写文件 4-文件不存在“ ErrMsg = C_ErrMsg End Property 请问如何正确杀掉word进程？
楼主btl19792008（btl19792008）2005-11-04 17:05:03 在 VB / 数据库(包含打印，安装，报表)提问 我的word程序运行几次，在资源管理器中就会出现很多word进程。
我的代码写的不对吗？
代码如下：
Dim appTemplate As Word.Application
Dim docTemplate As Word.Document
Set appTemplate = GetObject(, ”Word.Application“)
If Err.Number = 429 Then
Set appTemplate = New Word.Application
End If
Set docTemplate = Nothing
Set appTemplate = Nothing
问题点数：100、回复次数：9Top 楼bbhere（俺是二等小兵(baby,i'll be right here waiting for you)）回复于 2005-11-04 17:31:33 得分 0 markTop 楼province_（雍昊）回复于 2005-11-04 18:03:37 得分 0 要先QUIT再NOTHING。Top 楼faysky2（出来混，迟早是要还嘀）回复于 2005-11-04 19:21:30 得分 0
'引用Microsoft Word X.0 Object Library
Private Sub Command1_Click()
On Error GoTo connecterr
Dim wordApp As Object
Set wordApp = CreateObject(”word.application“)
wordApp.Visible = True
Dim myDoc As Object
Set myDoc = wordApp.Documents.Open(”c:Test.dot“)
wordApp.selection.TypeText(” Hello“)
myDoc.Close '关闭
wordApp.Quit
'退出
Set myDoc = Nothing
Set wordApp = Nothing
Exit Sub
connecterr:
End Sub
Top 楼faysky2（出来混，迟早是要还嘀）回复于 2005-11-04 19:24:16 得分 0 Dim appTemplate As Word.Application
Dim docTemplate As Word.Document
Set appTemplate = GetObject(, ”Word.Application“)
If Err.Number = 429 Then
Set appTemplate = New Word.Application
End If
'**************
docTemplate.Close
appTemplate.Quit
'**************
Set docTemplate = Nothing
Set appTemplate = NothingTop 楼rainstormmaster（暴风雨 v2.0）回复于 2005-11-06 11:01:27 得分 0 没有office没法测试，不过我想你可以参考一下这个：
http://blog.joycode.com/mvm/archive/2004/04/25/20208.aspxTop 6 楼ahlegend（爱之传奇）回复于 2005-11-06 20:51:45 得分 0 QuitTop 楼szjhxu（天野）回复于 2005-11-06 22:01:48 得分 0 Dim appTemplate As Word.Application
Dim docTemplate As Word.Document
Set appTemplate = GetObject(, ”Word.Application")
If Err.Number = 429 Then
Set appTemplate = New Word.Application
End If
appTemplate.quit
Set docTemplate = Nothing
Set appTemplate = NothingTop 楼zhf_btj（闹闹）回复于 2005-11-15 21:54:47 得分 0 引用四楼
faysky2()
myDoc.Close '关闭
wordApp.Quit
'退出
Set myDoc = Nothing
Set wordApp = Nothing
这样应该能退干净了...我的就是..光用Close和Quit.没用Nothing就老有多余的进程
偶尔试下加个Nothing就OK了~~~~Top 楼lfh103856111（）回复于 2005-11-16 12:46:09 得分 0 對,注意quit就行了
第二篇：VB操作wincc脚本心得
Vbs 操作wincc画面脚本总结
一： 不使用变量单纯的操作界面
1.操作某个画面中控件的属性 如 Home1.Pdl（总窗体）下的 画面窗口2（画面窗口）
Sub OnClick(ByVal Item)
Dim objCircle Dim screenname Dim pwname Set objCircle= ScreenItems(“圆1”)objCircle.Radius = 60
Set screenname=HMIRuntime.Screens(“Home1”)
//获取要操作的窗体
Set pwname=screenname.ScreenItems(“画面窗口2”)
//获取要操作的控件，这里填入你要操作的控件名
MsgBox(objCircle.Radius)
//输出圆的半径
MsgBox(pwname.Picturename)
//输出当前画面窗口2的名字 End Sub
注意
当调用某窗体下的某控件的某个属性时,需要声明两个对象，一个接纳这个控件，一个接纳值
例如
Dim object Dim value Set object =HMIRuntime.Screens(“Home1”).ScreenItems(“画面窗口2”)Set value=object.picturename
2.更改画面窗口的对象
Sub OnClick(Byval Item)
Dim opObject Set opObject=HMIRuntime.Screens(“Home1”).ScreenItems(“画面窗口2”)opObject.PictureName=“Page1.Pdl” End Sub 3.设置文本
Set titleTxt=HMIRuntime.Screens(“Home1”).ScreenItems(“静态文本2”)titleTxt.Text =titleTxt.Text+“EF” //获取文本的值并追加字符
4.vb 字符串函数
VB的字符串截取函数有Left（字符串，n），返回字符串前N个字符；Mid（字符串，p，n），从第p个字符开始，向后截取N个字符；right（字符串，n），返回字符串的最后n个字符。
获取下标
VB中的InStr()函数与InStrRev()函数：
都是在主字符串当中搜寻寻找子字符串，返回找到的子字符串在主字符串中出现的位置； 不同在于；
InStr()函数，从左开始向右寻找，InStrRev()函数，从右开始向左寻找。
截取 right 和left
获取长度 Len 二：操作变量
1.Dim objTag Dim AText Set objTag = HMIRuntime.Tags(“a”)
//获取变量 objTag.Read
//执行读取
Set AText=ScreenItems(“静态文本2”)//获取控件 AText.Text=objTag.Value //给控件写入值 objTag.Value =100 //给目标变量写入值 objTag.Write
//执行写入
2.vb 中 Switch 语句的变体
Dim objTag Dim AText Set objTag = HMIRuntime.Tags(“a”)
//获取内部变量a的值
objTag.Read
//必须要有这一步，这是读取操作，同理如果改写值必须要有ogjTag.write Set AText=ScreenItems(“静态文本2”)
Select Case objTag.Value Case 1 AText.Text=“a” Case 2 AText.Text=“b” Case Else AText.Text=objTag.Value End Select
三．弹出对话框
设置
buttons 参数可以有以下值：
常数 值 描述
vbOKOnly 0 只显示确定按钮。vbOKCancel 1 显示确定和取消按钮。
vbAbortRetryIgnore 2 显示放弃、重试和忽略按钮。vbYesNoCancel 3 显示是、否和取消按钮。vbYesNo 4 显示是和否按钮。
vbRetryCancel 5 显示重试和取消按钮。vbCritical 16 显示临界信息图标。vbQuestion 32 显示警告查询图标。vbExclamation 48 显示警告消息图标。vbInformation 64 显示信息消息图标。vbDefaultButton1 0 第一个按钮为默认按钮。vbDefaultButton2 256 第二个按钮为默认按钮。vbDefaultButton3 512 第三个按钮为默认按钮。vbDefaultButton4 768 第四个按钮为默认按钮。
vbApplicationModal 0 应用程序模式：用户必须响应消息框才能继续在当前应用程序中工作。
vbSystemModal 4096 系统模式：在用户响应消息框前，所有应用程序都被挂起。
第一组值(0-5)用于描述对话框中显示的按钮类型与数目；第二组值(16, 32, 48, 64)用于描述图标的样式；第三组值(0, 256, 512)用于确定默认按钮；而第四组值(0, 4096)则决定消息框的样式。在将这些数字相加以生成 buttons 参数值时，只能从每组值中取用一个数字。返回值
MsgBox 函数有以下返回值：
常数 值 按钮 vbOK 1 确定 vbCancel 2 取消 vbAbort 3 放弃 vbRetry 4 重试 vbIgnore 5 忽略 vbYes 6 是 vbNo 7 否
下面的例子演示了 MsgBox 函数的用法：
Dim MyVar
MyVar = MsgBox(“Hello World!”, 65, “MsgBox Example”)' MyVar contains either 1 or 2, depending on which button is clicked.你要求是有是和否两个按钮那么MyVar = MsgBox(“Hello World!”, 65, “MsgBox Example”)中的65改成4就可以了！
vbs脚本中：
if msgbox(“确实要启动设备吗？”，4，“警告”)=6 then
hmiruntime.tags(“tag1”).write 1
end if
第三篇：Vb操作excel的命令（范文模版）
用VB操作Excel的办法
[日期：2008-11-23]
来源：
作者：
[字体：大 中
小] Private Sub Command3_Click()
On Error GoTo err1
Dim i As Long
Dim j As Long
Dim objExl As Excel.Application '声明对象变量
Me.MousePointer = 11
'改变鼠标样式
Set objExl = New Excel.Application
'初始化对象变量
objExl.SheetsInNewWorkbook = 1 '将新建的工作薄数量设为1
objExl.Workbooks.Add
'增加一个工作薄
objExl.Sheets(objExl.Sheets.Count).Name = “book1” '修改工作薄名称
objExl.Sheets.Add , objExl.Sheets(“book1”)'增加第二个工作薄在第一个之后
objExl.Sheets(objExl.Sheets.Count).Name = “book2”
objExl.Sheets.Add , objExl.Sheets(“book2”)'增加第三个工作薄在第二个之后
objExl.Sheets(objExl.Sheets.Count).Name = “book3”
objExl.Sheets(“book1”).Select
'选中工作薄
For i = 1 To 50
'循环写入数据
For j = 1 To 5
If i = 1 Then
objExl.Selection.NumberFormatLocal = “@” '设置格式为文本
objExl.Cells(i, j)= “ E ” & i & j
Else
objExl.Cells(i, j)= i & j
End If
Next
Next
objExl.Rows(“1:1”).Select
'选中第一行
objExl.Selection.Font.Bold = True '设为粗体
objExl.Selection.Font.Size = 24
'设置字体大小
objExl.Cells.EntireColumn.AutoFit '自动调整列宽
objExl.ActiveWindow.SplitRow = 1 '拆分第一行
objExl.ActiveWindow.SplitColumn = 0 '拆分列
objExl.ActiveWindow.FreezePanes = True '固定拆分
objExl.ActiveSheet.PageSetup.PrintTitleRows = “$1:$1” '设置打印固定行
objExl.ActiveSheet.PageSetup.PrintTitleColumns = “"
'打印标题
objExl.ActiveSheet.PageSetup.RightFooter = ”打印时间: “ & _
Format(Now, ”yyyy年mm月dd日 hh:MM:ss“)
objExl.ActiveWindow.View = xlPageBreakPreview
'设置显示方式
objExl.ActiveWindow.Zoom = 100
'设置显示大小
'给工作表加密码
objExl.ActiveSheet.Protect ”123“, DrawingObjects:=True, _
Contents:=True, Scenarios:=True
objExl.Application.IgnoreRemoteRequests = False
objExl.Visible = True
'使EXCEL可见
objExl.Application.WindowState = xlMaximized
'EXCEL的显示方式为最大化
objExl.ActiveWindow.WindowState = xlMaximized
'工作薄显示方式为最大化
objExl.SheetsInNewWorkbook = 3
'将默认新工作薄数量改回3个
Set objExl = Nothing
'清除对象
Me.MousePointer = 0 '修改鼠标
Exit Sub
err1:
objExl.SheetsInNewWorkbook = 3
objExl.DisplayAlerts = False '关闭时不提示保存
objExl.Quit
'关闭EXCEL
objExl.DisplayAlerts = True '关闭时提示保存
Set objExl = Nothing
Me.MousePointer = 0 End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
全面控制 Excel
首先创建 Excel 对象，使用ComObj: Dim ExcelID as Excel.Application Set ExcelID as new Excel.Application
1)显示当前窗口：ExcelID.Visible := True;
2)更改 Excel 标题栏：ExcelID.Caption := '应用程序调用 Microsoft Excel';
3)添加新工作簿：ExcelID.WorkBooks.Add;
4)打开已存在的工作簿：ExcelID.WorkBooks.Open('C:ExcelDemo.xls');
5)设置第2个工作表为活动工作表：ExcelID.WorkSheets[2].Activate;或 ExcelID.WorkSheets[ 'Sheet2' ].Activate;
6)给单元格赋值：ExcelID.Cells[1,4].Value := '第一行第四列';
7)设置指定列的宽度（单位：字符个数），以第一列为例：
ExcelID.ActiveSheet.Columns[1].ColumnsWidth := 5;
8)设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：
ExcelID.ActiveSheet.Rows[2].RowHeight := 1/0.035;// 1厘米
9)在第8行之前插入分页符：
ExcelID.WorkSheets[1].Rows[8].PageBreak := 1;
10)在第8列之前删除分页符：
ExcelID.ActiveSheet.Columns[4].PageBreak := 0;
11)指定边框线宽度：
ExcelID.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;
1-左
2-右
3-顶
4-底
5-斜()
6-斜(/)
12)清除第一行第四列单元格公式：ExcelID.ActiveSheet.Cells[1,4].ClearContents;
13)设置第一行字体属性：
ExcelID.ActiveSheet.Rows[1].Font.Name := '隶书';ExcelID.ActiveSheet.Rows[1].Font.Color := clBlue;ExcelID.ActiveSheet.Rows[1].Font.Bold := True;ExcelID.ActiveSheet.Rows[1].Font.UnderLine := True;
14)进行页面设置：
a.页眉：ExcelID.ActiveSheet.PageSetup.CenterHeader := '报表演示';b.页脚：ExcelID.ActiveSheet.PageSetup.CenterFooter := '第&P页';c.页眉到顶端边距2cm：ExcelID.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;d.页脚到底端边距3cm：ExcelID.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;e.顶边距2cm：ExcelID.ActiveSheet.PageSetup.TopMargin := 2/0.035;f.底边距2cm：ExcelID.ActiveSheet.PageSetup.BottomMargin := 2/0.035;g.左边距2cm：ExcelID.ActiveSheet.PageSetup.LeftMargin := 2/0.035;h.右边距2cm：ExcelID.ActiveSheet.PageSetup.RightMargin := 2/0.035;i.页面水平居中：ExcelID.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;j.页面垂直居中：ExcelID.ActiveSheet.PageSetup.CenterVertically := 2/0.035;k.打印单元格网线：ExcelID.ActiveSheet.PageSetup.PrintGridLines := True;
15)拷贝操作：
a.拷贝整个工作表：ExcelID.ActiveSheet.Used.Range.Copy;b.拷贝指定区域：ExcelID.ActiveSheet.Range[ 'A1:E2' ].Copy;c.从A1位置开始粘贴：ExcelID.ActiveSheet.Range.[ 'A1' ].PasteSpecial;d.从文件尾部开始粘贴：ExcelID.ActiveSheet.Range.PasteSpecial;
16)插入一行或一列：
a.ExcelID.ActiveSheet.Rows[2].Insert;
b.ExcelID.ActiveSheet.Columns[1].Insert;
17)删除一行或一列：
a.ExcelID.ActiveSheet.Rows[2].Delete;
b.ExcelID.ActiveSheet.Columns[1].Delete;
18)打印预览工作表：
ExcelID.ActiveSheet.PrintPreview;
19)打印输出工作表：
ExcelID.ActiveSheet.PrintOut;
20)工作表保存：
If not ExcelID.ActiveWorkBook.Saved then
ExcelID.ActiveSheet.PrintPreview
End if
21)工作表另存为：
ExcelID.SaveAs('C:ExcelDemo1.xls');22)放弃存盘：
ExcelID.ActiveWorkBook.Saved := True;
23)关闭工作簿：
ExcelID.WorkBooks.Close;
24)退出 Excel：ExcelID.Quit;
25)设置工作表密码: ExcelID.ActiveSheet.Protect ”123“, DrawingObjects:=True, Contents:=True, Scenarios:=True
26)EXCEL的显示方式为最大化
ExcelID.Application.WindowState = xlMaximized
27)工作薄显示方式为最大化
ExcelID.ActiveWindow.WindowState = xlMaximized
28)设置打开默认工作薄数量
ExcelID.SheetsInNewWorkbook = 3
29)'关闭时是否提示保存(true 保存；false 不保存)ExcelID.DisplayAlerts = False
30)设置拆分窗口,及固定行位置 ExcelID.ActiveWindow.SplitRow = 1 ExcelID.ActiveWindow.FreezePanes = True
31)设置打印时固定打印内容
ExcelID.ActiveSheet.PageSetup.PrintTitleRows = ”$1:$1“
32)设置打印标题
ExcelID.ActiveSheet.PageSetup.PrintTitleColumns = ”"
33)设置显示方式(分页方式显示)ExcelID.ActiveWindow.View = xlPageBreakPreview
34)设置显示比例
ExcelID.ActiveWindow.Zoom = 100
35)让Excel 响应 DDE 请求
Ex.Application.IgnoreRemoteRequests = False
Vb操作excel的命令
1．创建Excel对象
eole=CREATEOBJECT(′Excel.application′)
2．添加新工作簿
eole.Workbooks.add
3．设置第3个工作表为激活工作表
eole.Worksheets(″sheet3″).Activate
4．打开指定工作簿
eole.Workbooks.Open(″c:templl.xls″)
5．显示Excel窗口
eole.visible=.t.6．更改Excel标题栏
eole.Caption=″VFP应用程序调用Microsoft Excel″
7．给单元格赋值
eole.cells(1,4).value=XM(XM为数据库字段名)
8．设置指定列的宽度(单位：字符个数)
eole.ActiveSheet.Columns(1).ColumnWidth=5
9．设置指定行的高度(单位：磅)
eole.ActiveSheet.Rows(1).RowHeight=1/0.035
(设定行高为1厘米，1磅=0.035厘米)
10．在第18行之前插入分页符
eole.Worksheets(″Sheet1″).Rows(18).PageBreak=1
11．在第4列之前删除分页符
eole.ActiveSheet.Columns(4).PageBreak=0
12．指定边框线宽度(Borders参数如下)
ole.ActiveSheet.Range(″b3:d3″).Borders(2).Weight=3
13．设置四个边框线条的类型
eole.ActiveSheet.Range(″b3:d3″).Borders(2).LineStyle=1
(其中Borders参数：1－左、2－右、3－顶、4－底、5－斜、6－斜/；LineStyle值：1与7－细实、2－细虚、4－点虚、9－双细实线)
14．设置页眉
eole.ActiveSheet.PageSetup.CenterHeader=″报表1″
15．设置页脚
eole.ActiveSheet.PageSetup.CenterFooter=″第＆P页″
16．设置页眉到顶端边距为2厘米
eole.ActiveSheet.PageSetup.HeaderMargin=2/0.035
17．设置页脚到底边距为3厘米
eole.ActiveSheet.PageSetup.FooterMargin=3/0.035
18．设置顶边距为2厘米
eole.ActiveSheet.PageSetup.TopMargin=2/0.035
19．设置底边距为4厘米
eole.ActiveSheet.PageSetup.BottomMargin=4/0.035
20．设置左边距为2厘米
veole.ActiveSheet.PageSetup.LeftMargin=2/0.035
21．设置右边距为2厘米
eole.ActiveSheet.PageSetup.RightMargin=2/0.035
22．设置页面水平居中
eole.ActiveSheet.PageSetup.CenterHorizontally=.t.23．设置页面垂直居中
eole.ActiveSheet.PageSetup.CenterVertically=.t.24．设置页面纸张大小(1－窄行8511 39－宽行1411)
eole.ActiveSheet.PageSetup.PaperSize=1
25．打印单元格网线
eole.ActiveSheet.PageSetup.PrintGridlines=.t.26．拷贝整个工作表
eole.ActiveSheet.UsedRange.Copy
27．拷贝指定区域
eole.ActiveSheet.Range(″A1:E2″).Copy
28．粘贴
eole.WorkSheet(″Sheet2″).Range(″A1″).PasteSpecial
29．在第2行之前插入一行
eole.ActiveSheet.Rows(2).Insert
30．在第2列之前插入一列
eole.ActiveSheet.Columns(2).Insert
31．设置字体
eole.ActiveSheet.Cells(2,1).Font.Name=″黑体″
32．设置字体大小
eole.ActiveSheet.Cells(1,1).Font.Size=25
33．设置字体为斜体
eole.ActiveSheet.Cells(1,1).Font.Italic=.t.34．设置整列字体为粗体
eole.ActiveSheet.Columns(1).Font.Bold=.t.35．清除单元格公式
eole.ActiveSheet.Cells(1,4).ClearContents
36．打印预览工作表
eole.ActiveSheet.PrintPreview
37．打印输出工作表
eole.ActiveSheet.PrintOut
38．工作表另为
eole.ActiveWorkbook.SaveAs(″c:temp22.xls″)
39．放弃存盘
eole.ActiveWorkbook.saved=.t.40．关闭工作簿
eole.Workbooks.close
41．退出Excel eole.quit
第四篇：全国VB二级操作试题及答案2016
一、基本操作题
(1)在名称为Forml，标题为“输入”、最大化按钮不可用的窗体上画1个名称为Framel的框架控件，其标题为“选择性别”;再向框架内画两个名称分别为Optionl和Option2的单选按钮，其标题分别为“男”和“女”，并将单选按钮Option2设置为选中状态。请设置相应属性使得程序执行时，窗体界面如图所示。
注意：存盘时，将文件保存至考生文件夹下，窗体文件名为sjtl.frm，工程文件名为sjtl.vbp。
(2)在名称为Forml的窗体上画1个名称为Labell的标签，其标题为“计算机等级考试”，且能根据标题内容自动调整大小，有边框(如图所示);再在窗体上画1个名称为HScrolll的水平滚动条，并将滚动条所能表示的最小值设置为
10、最大值设置为20。
要求：编写适当的事件过程，使得程序运行时，当单击水平滚动条两端的箭头时，能将标签中的文字大小设置为滚动框当前位置值，程序运行后的界面如图所示。
注意：程序中不得使用变量，每个事件过程中只能写一条语句(不得使用选择语句或循环语句)。存盘时必须存放在考生文件夹下，工程文件名为sjt2.vbp，窗体文件名为sjt2.frm。
二、简单应用题
(1)考生文件夹中有工程文件sjt3.vbv。窗体上显示有一个列表框和一个文本框，且列表框中已有若干列表项。程序的功能是，程序运行时，当用户在列表框中单击并选中某个列表项时，该项的内容将显示到文本框中，用户可以在文本框中对相关内容进行编辑，按回车键后，能够用编辑好的内容替换被选中的列表项，并自动清空文本框;当双击某个列表项时，则从列表框中删除该列表项;当用户直接在文本框中键入文本并按回车键后，则把该文本添加为列表框的一个新列表项，添加完成后，将文本框清空。运行窗体如图所示。
要求：程序已经给出，但不完整，请将其中的注释符去掉，把“?”改为正确的内容，以实现上述程序功能。
注意：考生不得修改窗体文件中已经存在的控件和程序。最后程序按原文件名存盘。
(2)考生文件夹中有一个工程文件sjt4.vbp。窗体上有两个文本框和一个标题为“运算”的命令按钮。程序的功能是，当程序运行时，单击“运算”按钮，能够产生10个1～100之间的随机整数，并显示在上面一个文本框中，然后，程序从中找出一个最大值，并将最大值与第1个数互换位置，最后把结果显示在下面一个文本框中。下图为程序某次运行的结果。程序已经给出，但不完整，请将其中的注释符去掉，把“?”改为正确的内容，以实现上述程序功能。
注意：考生不得修改窗体文件中已经存在的控件和程序，最后程序按原文件名存盘。
三、综合应用题
考生文件夹下有工程文件sjt5.vbp，窗体界面如图所示。考生文件夹下的in5.dat文件中有某次歌睦大奖赛10位选手的得分，文件中的每一行数据包含选手的编号及5位评委的打分。程序运行时，单击“显示数据”按钮，则将in5.dat文件的内容读入二维数组a中，并将数组a各元素的值显示在Textl文本框中;单击“计算并排序”按钮，则先计算每位选手的平均分作为最后得分，再按最后得分从高到低排序，最后按序在Listl列表框中显示各选手的编号和最后得分(每组编号和最后得分用空格隔开作为一行)。单击“保存”按钮，则保存结果。“显示数据”和“保存”按钮的Click事件过程已经给出，请编写“计算并排序”按钮的Click事件过程实现上述功能。
注意：考生不得修改窗体文件中已经存在的控件和程序，在结束程序运行之前，必须单击“计算并排序”按钮后，再单击“保存”按钮保存结果，否则无成绩。最后，程序按原文件名存盘。
参考答案及解析
一、基本操作题
(1)【解题思路】新建一个空白窗体，添加一个框架控件和两个单选按钮控件，设置窗体和控件的相关属性值。
【操作步骤】
步骤1：新建一个“输入”、最大化按钮不可用的窗体，相关属性设置如表4.1所示。
步骤2：向窗体中添加一个框架控件和两个选项按钮，并设置好相关属性，如表4.2所示。
设置完成后效果如图4.1所示。
步骤3：调试并运行程序，关闭程序后按题目要求存盘。
(2)【解题思路】新建一个空白窗体，添加一个标签控件和一个水平滚动条控件，设置好该控件的相关属性，最后通过水平滚动条的change事件，将标签控件的fontSize属性设置为滚动条的value值。
步骤3：添加一个水平滚动条，设置控件的相关属性，如
表4.4所示。
设置完成后，窗体运行效果如图4.2所示。
步骤5：调试并运行程序，关闭程序后按题目要求存盘。
二、简单应用题
(1)【解题思路】本题主要考查对列表框控件的使用，包括向列表框中增加项目，从列表框中删除项目。修改列表框中选中项目的值。
第一个空使用列表框的Text属性，该属性的值为最后一次选中的表项的文本。
第二个空使用列表框的Lisflndex属性，该属性的值是已选中的表项的位置。
第三个空判断Text1文本框中的内容是否为空。
第四个空表示当列表框中无选中项目时，将Text1中的内容添加到列表框的最后。
第五个空表示将Text1文本框中的文本替换为列表框中选中的项目，使用列表框的List和ListIndex属性。
步骤3：调试并运行程序，关闭程序后按题目要求存盘
(2)【解题思路】本题主要考核对数组中元素的基本操作，利用循环语句找出数组中的最大值，并将保存最大值和其所对应的下标，然后将最大值与数组中的第一个元素进行互换操作。
三、综合应用题
【解题思路】本题主要考核列表框控件的基本操作，在事件过程中利用循环结构对二维数组中的元素求平均值，并将结果添加到列表框中，然后利用二重循环结构对列表框中的元素进行降序排列。
步骤3：调试并运行程序，关闭程序后按题目要求存盘。
第五篇：Vb对excel操作的实例
Vb对excel操作的实例
最近，由于工作关系，我用vb6.0做了一个计算成绩的软件，由于我不会数据库技术，同行对excel应用又比较普遍，所以就用vb6.0操作excel完成了成绩统计的任务。
先说说窗体，很简单，只运用了菜单，由此来调用程序代码。截图如下：
窗体命名为excel操作，共五个一级菜单。
创建表册用来制作所用表格。
计算成绩用来算成绩。
模拟运算用来测试软件，设置了两个子菜单，一个填随机生成的数据。有了数据就可以计算成绩了，看看效果如何。
测试完了就可以清空数据了，清空成绩册中的基础数据以后再计算一次成绩就基本可以使表册恢复原样了。其实，我这是多此一举，回头一想，只需要重新创建所用表册就行了。
还画蛇添足了俩菜单：计算器和退出。代码也贴出来共享一下。创建表册：一年级： Private Sub ynjkb_Click()Call 建空表(10)Call 工作表命名(1)Call 成绩册(1)Unload excel操作 End Sub 创建表册：二年级： Private Sub enjkb_Click()Call 建空表(10)Call 工作表命名(2)Call 成绩册(2)Unload excel操作 End Sub 三至六年级略了吧。创建表册：学校总评： Private Sub xxzp_Click()nj(1)= “一年级”: nj(2)= “二年级”: nj(3)= “三年级”: nj(4)= “四年级”: nj(5)= “五年级”: nj(6)= “六年级” Call 建空表(2)'建立积分表
Sheets(1).Name = “学校积分” Sheets(2).Name = “积分” Sheets(“学校积分”).Select Range(“a1:i1”).Merge [a1] = “学校积分统计表”: [a2] = “学校”: [a3] = “南村小学”: [a4] = “东风小学”: [a5] = “兴中小学”: [a6] = “尧场小学” nj(1)= “一年级”: nj(2)= “二年级”: nj(3)= “三年级”: nj(4)= “四年级”: nj(5)= “五年级”: nj(6)= “六年级” For i = 1 To 6 Cells(2, i + 1)= nj(i)+ “积分” Next Cells(2, 8)= “均积分”: Cells(2, 9)= “名次” Range([a1], [i6]).Select Selection.HorizontalAlignment = xlCenter Call 表格加线(Range([a2], [i6]))Call 横排(6, 9)ActiveSheet.PageSetup.Orientation = xlLandscape Unload excel操作 End Sub 创建表册：上报：
Private Sub shangbao_Click()Call 建空表(2)Sheets(1).Name = “中心校” Sheets(“中心校”).Select Call 上报表(“中心校”)Sheets(2).Name = “普小” Sheets(“普小”).Select Call 上报表(“普小”)Unload excel操作 End Sub 计算成绩：一年级： Private Sub yinianji_Click()Call 打开工作表 Call 算成绩(1)kmb(1)= “语文”: kmb(2)= “数学”: kmb(3)= “英语” Sheets(kmb(1)).Select For i = 1 To 8
'记录一年级语文数据 With bj(i).xxmc = Cells(2, i + 1).dkjs = Cells(3, i + 1).xkrs = Cells(4, i + 1).xkzf = Cells(5, i + 1).xkjgr = Cells(6, i + 1).xkyxr = Cells(7, i + 1).xkjf = Cells(8, i + 1).bjkm = kmb(1).njxh = 1 End With Next Sheets(kmb(2)).Select For i = 1 To 8
'记录一年级数学数据 With bj(i + 8).xxmc = Cells(2, i + 1).dkjs = Cells(3, i + 1).xkrs = Cells(4, i + 1).xkzf = Cells(5, i + 1).xkjgr = Cells(6, i + 1).xkyxr = Cells(7, i + 1).xkjf = Cells(8, i + 1).bjkm = kmb(2).njxh = 1 End With Next Dim hgrs(8)
'记录各学校合格人数 For i = 1 To 8 Sheets(xx(i)).Select szl = Application.WorksheetFunction.Match(“总分”, Range([a2], [f2]))'总分所在列即合格人数所在列
szh = Application.WorksheetFunction.Match(“合格人数”, Range(Cells(2, szl), Cells(80, szl)))'“合格人数”所在行
hgrs(i)= Cells(szh + 2, szl)Next '向学校总评表过录一年级数据
nj(1)= “一年级”: nj(2)= “二年级”: nj(3)= “三年级”: nj(4)= “四年级”: nj(5)= “五年级”: nj(6)= “六年级” Workbooks.Open FileName:=ActiveWorkbook.Path & “学校总评.xls” For i = 1 To 16 With Sheets(“积分”)Sheets(“积分”).Select [a1] = “年级”: [a2] = “学科”: [a3] = “学校”: [a4] = “人数”: [a5] = “总分”: [a6] = “及格人数”: [a7] = “优秀人数”: [a8] = “积分”.Cells(1, i + 1)= nj(bj(i).njxh).Cells(2, i + 1)= bj(i).bjkm.Cells(3, i + 1)= bj(i).xxmc.Cells(4, i + 1)= bj(i).xkrs.Cells(5, i + 1)= bj(i).xkzf.Cells(6, i + 1)= bj(i).xkjgr.Cells(7, i + 1)= bj(i).xkyxr.Cells(8, i + 1)= bj(i).xkjf End With Next Workbooks.Open FileName:=ActiveWorkbook.Path & “上报.xls” With Sheets(“中心校”)'过录中心校成绩.Cells(bj(1).njxh * 2 + 2, 3)= bj(1).xkrs + bj(2).xkrs + bj(6).xkrs '语文
.Cells(bj(1).njxh * 2 + 2, 4)= bj(1).xkzf + bj(2).xkzf + bj(6).xkzf.Cells(bj(1).njxh * 2 + 2, 5)= Round(.Cells(bj(1).njxh * 2 + 2, 4)/.Cells(bj(1).njxh * 2 + 2, 3), 2).Cells(bj(1).njxh * 2 + 2, 6)= bj(1).xkjgr + bj(2).xkjgr + bj(6).xkjgr.Cells(bj(1).njxh * 2 + 2, 7)= bj(1).xkyxr + bj(2).xkyxr + bj(6).xkyxr.Cells(bj(1).njxh * 2 + 2, 8)= hgrs(1)+ hgrs(2)+ hgrs(6).Cells(bj(1).njxh * 2 + 3, 3)= bj(9).xkrs + bj(10).xkrs + bj(14).xkrs '数学
.Cells(bj(1).njxh * 2 + 3, 4)= bj(9).xkzf + bj(10).xkzf + bj(14).xkzf.Cells(bj(1).njxh * 2 + 3, 5)= Round(.Cells(bj(1).njxh * 2 + 3, 4)/.Cells(bj(1).njxh * 2 + 3, 3), 2).Cells(bj(1).njxh * 2 + 3, 6)= bj(9).xkjgr + bj(10).xkjgr + bj(14).xkjgr.Cells(bj(1).njxh * 2 + 3, 7)= bj(9).xkyxr + bj(10).xkyxr + bj(14).xkyxr.Cells(bj(1).njxh * 2 + 3, 8)= hgrs(1)+ hgrs(2)+ hgrs(6)End With With Sheets(“普小”)'过录普小成绩
.Cells(bj(1).njxh * 2 + 2, 3)= bj(3).xkrs + bj(4).xkrs + bj(5).xkrs + bj(7).xkrs + bj(8).xkrs '语文
.Cells(bj(1).njxh * 2 + 2, 4)= bj(3).xkzf + bj(4).xkzf + bj(5).xkzf + bj(7).xkzf + bj(8).xkzf.Cells(bj(1).njxh * 2 + 2, 5)= Round(.Cells(bj(1).njxh * 2 + 2, 4)/.Cells(bj(1).njxh * 2 + 2, 3), 2).Cells(bj(1).njxh * 2 + 2, 6)= bj(3).xkjgr + bj(4).xkjgr + bj(5).xkjgr + bj(7).xkjgr + bj(8).xkjgr.Cells(bj(1).njxh * 2 + 2, 7)= bj(3).xkyxr + bj(4).xkyxr + bj(5).xkyxr + bj(7).xkyxr + bj(8).xkyxr.Cells(bj(1).njxh * 2 + 2, 8)= hgrs(3)+ hgrs(4)+ hgrs(5)+ hgrs(7)+ hgrs(8).Cells(bj(1).njxh * 2 + 3, 3)= bj(11).xkrs + bj(12).xkrs + bj(13).xkrs + bj(15).xkrs + bj(16).xkrs '数学
.Cells(bj(1).njxh * 2 + 3, 4)= bj(11).xkzf + bj(12).xkzf + bj(13).xkzf + bj(15).xkzf + bj(16).xkzf.Cells(bj(1).njxh * 2 + 3, 5)= Round(.Cells(bj(1).njxh * 2 + 3, 4)/.Cells(bj(1).njxh * 2 + 3, 3), 2).Cells(bj(1).njxh * 2 + 3, 6)= bj(11).xkjgr + bj(12).xkjgr + bj(13).xkjgr + bj(15).xkjgr + bj(15).xkjgr.Cells(bj(1).njxh * 2 + 3, 7)= bj(11).xkyxr + bj(12).xkyxr + bj(13).xkyxr + bj(15).xkyxr + bj(16).xkyxr.Cells(bj(1).njxh * 2 + 3, 8)= hgrs(3)+ hgrs(4)+ hgrs(5)+ hgrs(7)+ hgrs(8)End With Unload excel操作 End Sub 计算成绩：二年级略。计算成绩：三年级： Private Sub sannianji_Click()Call 打开工作表 Call 算成绩(3)kmb(1)= “语文”: kmb(2)= “数学”: kmb(3)= “英语” Sheets(kmb(1)).Select For i = 1 To 5
'记录三年级语文数据 With bj(i).xxmc = Cells(2, i + 1).dkjs = Cells(3, i + 1).xkrs = Cells(4, i + 1).xkzf = Cells(5, i + 1).xkjgr = Cells(6, i + 1).xkyxr = Cells(7, i + 1).xkjf = Cells(8, i + 1).bjkm = kmb(1).njxh = 3 End With Next Sheets(kmb(2)).Select For i = 1 To 5
'记录三年级数学数据 With bj(i + 5).xxmc = Cells(2, i + 1).dkjs = Cells(3, i + 1).xkrs = Cells(4, i + 1).xkzf = Cells(5, i + 1).xkjgr = Cells(6, i + 1).xkyxr = Cells(7, i + 1).xkjf = Cells(8, i + 1).bjkm = kmb(2).njxh = 3 End With Next Sheets(kmb(3)).Select For i = 1 To 5
'记录三年级英语数据 With bj(i + 10).xxmc = Cells(2, i + 1).dkjs = Cells(3, i + 1).xkrs = Cells(4, i + 1).xkzf = Cells(5, i + 1).xkjgr = Cells(6, i + 1).xkyxr = Cells(7, i + 1).xkjf = Cells(8, i + 1).bjkm = kmb(3).njxh = 3 End With Next xx(1)= “南村1”: xx(2)= “南村2”: xx(3)= “兴中”: xx(4)= “东风”: xx(5)= “尧场” Dim hgrs(5)
'记录各学校合格人数 For i = 1 To 5 Sheets(xx(i)).Select szl = Application.WorksheetFunction.Match(“总分”, Range([a2], [f2]))'总分所在列即合格人数所在列
szh = Application.WorksheetFunction.Match(“合格人数”, Range(Cells(2, szl), Cells(80, szl)))'“合格人数”所在行
hgrs(i)= Cells(szh + 2, szl)Next '向学校总评表过录积分
nj(1)= “一年级”: nj(2)= “二年级”: nj(3)= “三年级”: nj(4)= “四年级”: nj(5)= “五年级”: nj(6)= “六年级” Workbooks.Open FileName:=ActiveWorkbook.Path & “学校总评.xls” For i = 1 To 15 With Sheets(“积分”)[a21] = “年级”: [a22] = “学科”: [a23] = “学校”: [a24] = “人数”: [a25] = “总分”: [a26] = “及格人数”: [a27] = “优秀人数”: [a28] = “积分”.Cells(21, i + 1)= nj(bj(i).njxh).Cells(22, i + 1)= bj(i).bjkm.Cells(23, i + 1)= bj(i).xxmc.Cells(24, i + 1)= bj(i).xkrs.Cells(25, i + 1)= bj(i).xkzf.Cells(26, i + 1)= bj(i).xkjgr.Cells(27, i + 1)= bj(i).xkyxr.Cells(28, i + 1)= bj(i).xkjf End With Next Workbooks.Open FileName:=ActiveWorkbook.Path & “上报.xls” With Sheets(“中心校”)'过录中心校成绩
.Cells(bj(1).njxh * 31, 4)= bj(1).xkzf + bj(2).xkzf.Cells(bj(1).njxh * 31, 4)/.Cells(bj(1).njxh * 31, 6)= bj(1).xkjgr + bj(2).xkjgr.Cells(bj(1).njxh * 31, 8)= hgrs(1)+ hgrs(2).Cells(bj(1).njxh * 3, 3)= bj(6).xkrs + bj(7).xkrs
'数学.Cells(bj(1).njxh * 3, 4)= bj(6).xkzf + bj(7).xkzf.Cells(bj(1).njxh * 3, 5)= Round(.Cells(bj(1).njxh * 3, 4)/.Cells(bj(1).njxh * 3, 3), 2).Cells(bj(1).njxh * 3, 6)= bj(6).xkjgr + bj(7).xkjgr.Cells(bj(1).njxh * 3, 7)= bj(6).xkyxr + bj(7).xkyxr.Cells(bj(1).njxh * 3, 8)= hgrs(1)+ hgrs(2).Cells(bj(1).njxh * 3 + 1, 3)= bj(11).xkrs + bj(12).xkrs
'英语
.Cells(bj(1).njxh * 3 + 1, 4)= bj(11).xkzf + bj(12).xkzf.Cells(bj(1).njxh * 3 + 1, 5)= Round(.Cells(bj(1).njxh * 3 + 1, 4)/.Cells(bj(1).njxh * 3 + 1, 3), 2).Cells(bj(1).njxh * 3 + 1, 6)= bj(11).xkjgr + bj(12).xkjgr.Cells(bj(1).njxh * 3 + 1, 7)= bj(11).xkyxr + bj(12).xkyxr.Cells(bj(1).njxh * 3 + 1, 8)= hgrs(1)+ hgrs(2)End With With Sheets(“普小”)'过录普小成绩
.Cells(bj(1).njxh * 31, 4)= bj(3).xkzf + bj(4).xkzf + bj(5).xkzf.Cells(bj(1).njxh * 31, 4)/.Cells(bj(1).njxh * 31, 6)= bj(3).xkjgr + bj(4).xkjgr + bj(5).xkjgr.Cells(bj(1).njxh * 31, 8)= hgrs(3)+ hgrs(4)+ hgrs(5).Cells(bj(1).njxh * 3, 3)= bj(8).xkrs + bj(9).xkrs + bj(10).xkrs
'数学
.Cells(bj(1).njxh * 3, 4)= bj(8).xkzf + bj(9).xkzf + bj(10).xkzf.Cells(bj(1).njxh * 3, 5)= Round(.Cells(bj(1).njxh * 3, 4)/.Cells(bj(1).njxh * 3, 3), 2).Cells(bj(1).njxh * 3, 6)= bj(8).xkjgr + bj(9).xkjgr + bj(10).xkjgr.Cells(bj(1).njxh * 3, 7)= bj(8).xkyxr + bj(9).xkyxr + bj(10).xkyxr.Cells(bj(1).njxh * 3, 8)= hgrs(3)+ hgrs(4)+ hgrs(5).Cells(bj(1).njxh * 3 + 1, 3)= bj(13).xkrs + bj(14).xkrs + bj(15).xkrs '英语
.Cells(bj(1).njxh * 3 + 1, 4)= bj(13).xkzf + bj(14).xkzf + bj(15).xkzf.Cells(bj(1).njxh * 3 + 1, 5)= Round(.Cells(bj(1).njxh * 3 + 1, 4)/.Cells(bj(1).njxh * 3 + 1, 3), 2).Cells(bj(1).njxh * 3 + 1, 6)= bj(13).xkjgr + bj(14).xkjgr + bj(15).xkjgr.Cells(bj(1).njxh * 3 + 1, 7)= bj(13).xkyxr + bj(14).xkyxr + bj(15).xkyxr.Cells(bj(1).njxh * 3 + 1, 8)= hgrs(3)+ hgrs(4)+ hgrs(5)End With Unload excel操作 End Sub 计算成绩：三至六年级略。计算成绩：学校总评： Private Sub 学校总评_Click()Call 打开工作表 For i = 1 To 6 Call 算学校积分(i)Next Sheets(“学校积分”).Select For i = 3 To 6 Range(“h”
&
i)
= Round(Application.WorksheetFunction.Sum(Range(Range(“b” & i), Range(“g” & i)))/ 6, 2)Next For i = 3 To 6 Range(“i”
&
i)
&
= i), Application.WorksheetFunction.Rank(Range(“h” Range([h3], [h6]))Next Unload excel操作 End Sub 模拟运算：随机填成绩：一年级： Private Sub synj_Click()Call 打开工作表 Call 填数据(1)Unload excel操作 End Sub 模拟运算：随机填成绩：二年级至六年级略。模拟运算：清空成绩册：一年级： Private Sub qynj_Click()Call 打开工作表 Call 清数据(1)Unload excel操作 End Sub 模拟运算：清空成绩册：二年级至六年级略。计算器：
Private Sub jsq_Click()Shell “calc.exe” End Sub 退出：
Private Sub tc_Click()Unload excel操作 End Sub 框架已经完成，可以看出，卸载窗体的动作很频繁。这是我调试的结果，这样才能保证每次的动作都能顺利完成。我想这就是单窗体的特点吧。
被调用的程序模块也挺多的，系统包也调用了，最频繁的就是打开文件对话框的调用。
Private Sub 打开工作表()Application.FindFile Set xlApp = CreateObject(“Excel.Application”)xlApp.Visible = True '设置EXCEL对象可见（或不可见）End Sub 哦，还得说明一下，对excel的操作前提： Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet 本软件中，我第一次用了自定义类的数据类型。Private Type banji
xxmc As String
bjkm As String
njxh As Integer
xkrs As Integer
dkjs As String
xkzf As Integer
xkjgr As Integer
xkyxr As Integer
xkjf As Long End Type 并设了一数组Dim bj(16)As banji来从年级成绩册向学校总评表过录数据。设了八个学校名称Dim xx(8)，设了3个科目表Dim kmb(1 To 3)As String，六个年级Dim nj(1 To 6)As String，班级人数为六个年级八个学校的二维数组Dim gbrs(6, 8)。
至于其它程序模块都是我以前vba用过的，在我的空间里有，在此不再赘述。
点击咨询 