vb自动组卷(word文档)代码

合集下载

vb操作word全

ItIE.Bookmarks("mm").Ra nge.l nsertAfter " name"'在WORD 指定位置（标签）写入文本，指定位置指 WORDDim MyWord As Word.A ppi ication Dim MyWordBook As Word.Docume nt模版'MyWord = CreateObject("Word.A ppi icatio n")'MyWord.Visible = False'MyWord.ActiveDocume nt.SaveAs ("test1.doc")With MyWordBook!E一!E 除.Paragraphs(.Paragraphs.Count)贝U 表示所有行iiI ■iEit,■!E.Conten t.I nsertAfter "hello" & vbCrLf'向WORD 写入一行文字并回车.Co nte nt.l nsertAfter "hello".P aragra phs (.P aragra phs.Co un t).Ra nge.F on t.Size = 10.Co nte nt.l nsertAfter "hello"利用VB 操作WORD的基本方法I E !E !E I E,■!ESet MyWord = New Word.A ppi ication,■!ESet MyWordBook = MyWord.Docume nts.Add(Model Path & "test.dot")' 打开test.dot 用户自定义的 WORD!E■ I!'MyWord.Docume nts.O pen ("test.doc")'MyWord.ActiveDocume nt.Bookmarks .I tem("MM").Select!E■ I£i'MyWord.Selectio n.Text =" 从资料库取出的相应资料"I E■ I!EMyWordBook.ActivateIt '.P aragra phs(.P aragra phs.Co un t).Ra nge.F on t.Size = 30 '设置文字字体大小（其它设置类推）如果去P aragra phs(.P aragra phs.Co un t).Alig nment = wdAlig nP aragra phCe nter '设置文字居中等rr II 标签•Tables(1).Cell(2, 1).Ra nge.l nsertAfter " nameFDSAFDSAFDSA"'文本.Tables(1).Cell(2, 2).Ra nge.l nsertAfter "MM".Ra nge(Start:=. Paragra phs(2).Ra nge.Start + 3, En d:=. Paragra phs(2) .Ra nge.Start + 8).Font.Size = 30 '选定的文本（第二段开始位置加3至8的字体）设置字体，其它的累推.Tables(1).Cell(2, 1).Ra nge.Fo nt.Size = 20 '给选定的单元格设置字体，其它的累推Set MyWordBook = Noth ing !EI ■!E it!1、对其WORD 内容设置字体样式，以及在 WORD 中插入表格，以及表格单元格融合与填充 1I ■!E it *Qp ti on Exp licitii! Private Sub Comma nd1_Click()!E_I ■!!!Dim file name As Stri ng ! ■!EjCD.ShowSave:L!1,■!Efile name = CD.file nameiiI ■!ElOutWord file nameIE,■!E■ IliMsgBox "OK"lEnd Sub ! i!EI ■!E\[ __________________!1 !E I ■!E i f End With MyWord.Visible = True !E I ■ !E i f Set MyWord = Noth ing在WORD 第一个表格的第2行第1列插入I!E I ■!!tk! Private Fu nction OutWord(ByVal file Path As Stri ng) As Booleanii,■iSet newDoc = New Word.Docume ntI With newDoc!Earagra phs(.P aragra phs.Co un t).Ra nge.F on ="宋体"!..P aragra phs (.P aragra phs.Co un t).Ra nge.F on t.Size = 10.5!E!E,■#P aragra phs(.P aragra phs.Co un t).Alig nment = wdAlig nP aragra phRightI Lj.Co nte nt.l nsertAfter " 編号:"& vbCrLf!jI.P aragra phs(.P aragra phs.Co un t).Ra nge.F on =" 宋体"!EI;I.P aragra phs(.P aragra phs.Co un t).Ra nge.F on t.Size = 26IEI.P aragra phs(.P aragra phs.Co un t).Ra nge.F on t.Bold = TrueI ■!Ei.P aragra phs(.P aragra phs.Co un t).Alig nment = wdAlig nP aragra phCe nter ii iEI ■![Co nten t.I nsertAfter vbCrLf & "XXXXXXXXX報告"& vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf !E!E!ii.P aragra phs(.P aragra phs.Co un t).Ra nge.F on ="iiiEI ■宋体"*P aragra phs (.P aragra phs.Co un t).Ra nge.F on t.Bold = Falsei■!Eifi.P aragra phs(.P aragra phs.Co un t).Alig nment = wdAlig nP aragra phLeftiEi iCo nte nt.l nsertAfter "ii项目名称："& vbCrLf!.Co nte nt.l nsertAfter " !EI ■IE*Co nten t.I nsertAfter " 应急类型：” & vbCrLf预警状态：正常/警界/危机” & vbCrLfii!.P aragra phs(.P aragra phs.Co un t).Alig nment = wdAlig nP aragra phCe nter !E iiIf ……… … … …|HI.Tables.Add Ran ge:=.Ra nge(Start:=.Ra nge.E nd - 1, En d:=.Ra nge.E nd), NumRows:=1, NumColu mn s:=3,:■iDefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixedii[With .Tables 。

VB代码word

8月3日这些VBA代码会有用QQ:有没有办法得到一个excle表的行的总数和列的总数？？AA:edRange.Rows.CountedRange.Cols.CountQQ:如何打开一个word的模板！最近做一个word的模板程序，打开word是Set NewDoc =MyWord.Documents.Add这是一个新的doc,名字叫文档1（后面会累加，自动的），但是现在我希望直接新建打开一个我写好的模板程序，名字还是叫文档1。

请问应该怎么写！AA:On Error Resume Next '忽略错误Set Wrd = GetObject(, "Word.Application") '查找一个正在运行的Word拷贝If Err.Number <> 0 Then '如果Word 没有运行则Set Wrd = CreateObject("Word.Application") '运行它End IfErr.Clear '清除发生错误的Err 对象On Error GoTo 0 '保留普通错误进程Dim dot As StringDim doc As StringWrd.Visible =truedot = "C:\temp.dot"doc = "c:\temp.doc"Documents.Open FileName:=dot, _ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _ PasswordDocument:="", PasswordTemplate:="", Revert:=False, _ WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _Wrd.ActiveDocument.CloseWrd.Documents.Add Template:=dot, NewTemplate:=False'结果系列操作ActiveDocument.SaveAs FileName:=doc,FileFormat:=wdFormatDocument, _LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _False'打印出来ActiveDocument.PrintOut FileName:=doc, Range:=wdPrintAllDocument, Item:= _wdPrintDocumentContent, Copies:=1, Pages:="",PageType:=wdPrintAllPages, _ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _PrintZoomPaperHeight:=0Wrd.ActiveDocument.CloseWORD中打字Selection.TypeText Text:="您好，先生"如何让Word的保存命令调用我自己编写的保存方法？在doc文档被修改以后，在退出的时候当提示用户文档已经修改，问是否保存和直接点击保存按钮的时候，能否让Word去调用我自己编写的SaveDoc方法，如何实现？创建名为“FileSave”的宏，把你的代码写入在这个宏中。

VBA在Word中的应用--自动生成试卷

．
Ｓｅｌｅｃｔｉｏｎ．Ｓｔｖ１ｅ＝ＡｃｔｉｖｅＤｏｃｕｍｅｎｔ．Ｓｔｙｌｅｓ（ “ 标题１ ” ）
本系统主要有三大功能模块：添加试题、修改试题（包括修改和删除）和试卷自动生成。数据库采用Ａｃｃｅｓｓ，主要考虑它移植方便、便于管理。试题存放在数据库中，在对大量试卷分析时发现，
息
２０１４年２月１８日
ＶＢＡ莅Ｗｏｒｄ巾曲皮用
文，余姝华
留生试卷
摘
要：教师一般应用Ｗｏｒｄ来命制试卷，但收集试题和排版工作量非常繁重，利用ＶＢＡ在Ｗｏｒｄ中的应用，开发一个自带试题
库，教师可以对题库进行添加、修改和删除试题等功能；并能够对所选择的题目进行自动排版。教师可以高效完成一份高质量的试卷，
（２）试卷试题设置
耗时，试题的保密性差，所以在本系统中直接设计了试题库。题库
该模块分为四大块：基本知识（选择题和填空题）、现代文、文
可以对试题进行有效地保密，因为题库量很大，组卷时按条件随言文（文言文阅读和古诗）和写作。教师按照试卷的要求选择需要机组卷，猜题押宝命中概率很小。有了题库，可以马上启用备用的的题型，在对应题型下输入题数，若输入的题数大于系统库中的平行试卷，或在考试前的最后时刻随机决定平行试卷中的一套作题数，则系统会有相应提示。
二、系统功能模块分析

VB操作Word文档

VB创建，填充，预览，保存word文档的VB源代码Option Explicit’以下代码全部复制到VB标准模块中。

'word文档操作Private objApplication As Word.ApplicationPrivate objDocument As Word.DocumentPublic MyWordArray() As String '全局数组.'参数;strFilename 为模板文件的路径'功能；从一个模板文件创建一个新的word文档Public Function Create(ByVal strFilename As String) As BooleanSet objApplication = New Word.Application '一个新的word程序对象Set objDocument = objApplication.Documents.Add(strFilename)Create = TrueEnd Function入口参数；strFilename 是要保存的Word文件绝对路径值包含驱动器名称'保存文件Public Function Save(ByVal strFilename As String) As BooleanIf GFSO.FolderExists(App.Path & "\报表") = False ThenGFSO.CreateFolder App.Path & "\报表" '创建报表文件夹End IfobjDocument.SaveAs strFilenameSave = TrueEnd Function'功能；打印预览word文档Public Function Preview() As BooleanobjApplication.WindowState = wdWindowStateMaximizeobjApplication.Visible = TrueobjApplication.ActivateobjDocument.PrintPreviewPreview = TrueEnd Function'参数;strUnique 为指定的标志'参数;strValue 为替换的值'功能；替换word文档中指定的标志Public Function Find(ByVal strUnique As String, ByVal strValue As String) As Boolean Dim objFind As FindSet objFind = objDocument.Range.FindobjFind.Execute strUnique, , , , , , , , , strValue, wdReplaceAllFind = TrueEnd Function'入口参数;strFilename 为word文档的保存路径'功能；关闭word文档Public Function Quit(ByVal strFilename As String) As BooleanobjDocument.CloseobjApplication.Application.QuitSet objDocument = NothingSet objApplication = NothingQuit = TrueEnd Function'入口参数;MSHFA 是一个已填充数据的MSHF网格控件. '入口参数;Recordset_Array() 是一个全局数组用来存储经转换的二维数组'入口参数;RowValue 是指从那行开始转换为数组'功能；将MSHF网格中的数据转换为二维数组Public Function MSHF_to_Array(ByRef MSHFA As MSHFlexGrid, _ByRef MSHF_Array() As String, _ByVal RowValue As Long) As BooleanDim rows_value As Long '总行数Dim cols_value As Long '总列数Dim i As Long, j As Long '用于临时循环值.Dim rowindex As Long'找到总行数;For i = RowValue To MSHFA.Rows - 1rows_value = rows_value + 1Next'找到总列数;cols_value = MSHFA.Cols'为动态数组变量重新分配存储空间ReDim MSHF_Array(rows_value + 1, cols_value)'数组赋值For i = RowValue To MSHFA.Rows - 1For j = 0 To MSHFA.Cols - 1MSHF_Array(rowindex, j) = MSHFA.TextMatrix(i, j) & ""Nextrowindex = rowindex + 1NextMSHF_to_Array = TrueEnd Function'''参数;lngindex 为该表在该文档中的位置序号,从1开始'参数;strArray() 为要保存数据的二维数组.'功能；填充word文档中的表Public Function Fill(lngIndex As Long, ByRef strArray() As String) As Boolean Dim i As Long, j As LongDim objCell As Word.CellDim lngRows As LongFor i = 1 To UBound(strArray)'添加一行objDocument.Tables(lngIndex).Rows.Add'逐格填充数据For j = 1 To UBound(strArray, 2)lngRows = objDocument.Tables(lngIndex).Rows.CountSet objCell = objDocument.Tables(lngIndex).Rows(lngRows).Cells(j)objCell.Range.Text = strArray(i - 1, j - 1)NextNextSet objCell = NothingFill = TrueEnd Function’以下代码是窗体中调用代码范例。

VB操作WORD详解

VB操作WORD详解VB操作Word是一种常见的编程任务，可以用来自动化创建、修改和格式化Word文档。

VB是Visual Basic的简称，是一种简单易学的编程语言，广泛应用于Windows平台上的开发工作。

下面将详细介绍如何使用VB操作Word。

一、引用和初始化Word对象模型在使用VB操作Word之前，需要先引用Word对象模型。

在VB的项目中，点击“项目”菜单，选择“引用”，在弹出的对话框中找到并勾选“Microsoft Word xx.0 Object Library”（这里的xx表示Word的版本号），点击“确定”进行引用。

在VB中操作Word，首先要创建一个Word.Application对象，用来表示Word应用程序实例，在这个实例上进行后续的操作。

可以使用如下代码创建Word应用程序实例：Dim wdApp As Word.ApplicationSet wdApp = New Word.Application二、打开、创建和保存Word文档1. 打开现有的Word文档可以使用如下代码打开一个现有的Word文档：Dim wdDoc As Word.DocumentSet wdDoc = wdApp.Documents.Open("C:\path\to\your\file.docx")2. 创建新的Word文档可以使用如下代码创建一个新的Word文档：Dim wdDoc As Word.DocumentSet wdDoc = wdApp.Documents.Add3. 保存Word文档可以使用如下代码保存一个Word文档：wdDoc.SaveAs "C:\path\to\save\your\file.docx"三、操作Word文档内容1.读取和写入文本内容可以使用如下代码读取和写入文本内容：Dim strText As StringstrText = wdDoc.Range.Text '读取文档内容到字符串变量wdDoc.Range.Text = "Hello, World!" '向文档中写入文本内容2.插入和删除文本内容可以使用如下代码插入和删除文本内容：wdDoc.Range.InsertBefore "Insert Before" '在光标位置之前插入文本wdDoc.Range.InsertAfter "Insert After" '在光标位置之后插入文本wdDoc.Range.Delete '删除光标当前所在位置的文本3.格式化文本内容可以使用如下代码格式化文本内容，如设置字体、大小、颜色等： = "Arial" '设置字体为ArialwdDoc.Range.Font.Size = 12 '设置字体大小为12wdDoc.Range.Font.Color = RGB(255, 0, 0) '设置字体颜色为红色四、操作Word文档样式和格式1.设置段落样式可以使用如下代码设置段落的样式，如对齐方式、缩进等：wdDoc.Range.Paragraphs.Alignment = wdAlignParagraphCenter '设置居中对齐wdDoc.Range.Paragraphs.LeftIndent = 36 '设置左缩进为0.5英寸2.设置页面样式可以使用如下代码设置页面的样式，如边距、纸张大小等：wdDoc.PageSetup.TopMargin = 72 '设置页边距上为1英寸wdDoc.PageSetup.PaperSize = wdPaperA4 '设置纸张大小为A43.插入表格可以使用如下代码插入一个表格到Word文档：Dim wdTable As Word.TableSet wdTable = wdDoc.Tables.Add(wdDoc.Range, 3, 3) '添加3行3列的表格4.格式化表格可以使用如下代码格式化表格，如设置边框、背景颜色等：wdTable.Borders.InsideLineStyle = wdLineStyleSingle '设置内部边框为实线wdTable.Borders.OutsideLineStyle = wdLineStyleDouble '设置外部边框为双线wdTable.Rows(1).Cells(1).Shading.BackgroundPatternColor = RGB(255, 0, 0) '设置第一行第一列的背景颜色为红色五、关闭Word应用程序使用完Word应用程序后，需要关闭它以释放系统资源。

用vba在word中二次开发试题库

用vba在word中二次开发试题库试题库是一个非常重要的工具，在不同的领域，例如教育、培训、考试等，都需要使用试题库。

在这个数字化时代，使用电子试题库已经成为越来越普遍的选择。

Word软件作为Microsoft Office套件中的标志性软件，也可以用来创建和管理电子试题库。

VBA（Visual Basic for Applications）是一种用于Microsoft Office套件程序的编程语言，可以使用VBA来编写Word程序的宏和脚本。

使用VBA编写程序可以自动化一些重复性的工作，例如创建大量试题并导入到试题库中，也可以在试题库中快速搜索试题，删除试题等操作。

下面是一些可能的VBA编程实现试题库二次开发的功能：1. 批量导入试题：先将试题保存为txt格式，然后使用VBA读取txt文件中的试题进行解析和导入到试题库中。

可以通过弹出窗口设置试题的基本属性，如所属科目、难度、类型等。

2. 快速创建试题：可以编写VBA宏来自动生成一些试题，如选择题、填空题、判断题等。

这样可以减少手动输入试题的时间和工作量。

3. 批量修改试题：在试题库中进行批量操作，例如将某一类试题的难度级别全部提高或降低、更改试题的答案等。

可以通过搜索或筛选功能来进行批量操作。

4. 导出试题：通过VBA编写程序可以将试题以不同的格式导出，例如Excel、PDF、TXT等。

这样可以方便地将试题分享给其他人或用于复习备考。

5. 答案自动批改：编写一个自动批改程序可以将学生提交的答案与试题库中的答案进行比对，并得出成绩。

这样可以大大减少教师批改试卷的时间和工作量。

以上是一些可能的VBA编程实现试题库二次开发的功能，当然还可以根据实际需求进行更多的定制化开发。

诚然，在实现这些功能之前需要掌握一定的VBA编程知识，另外还需要进行不少的调试和测试工作。

但是，一旦开发好了试题库的VBA程序，将会帮助用户节省大量的时间并提高工作效率。

Vba自动设置试卷模板

Vba自动设置试卷模板注：此vba代码设置的结果是上页边距是2.1厘米，左右下页边距是2厘米，方向是横向排版，纸张是37*29，分2栏；把直箭头换行符换成回车换行符；删除空行。

代码都是自录制的（快过自己输入啊，现在的计算机执行这些代码飞一样的），复制下面的代码就可以用。

Sub 设置文档()' 分栏设置，页面设置成8kIf ActiveWindow.View.SplitSpecial <> wdPaneNone ThenActiveWindow.Panes(2).CloseEnd IfIf ActiveWindow.ActivePane.View.Type <> wdPrintView ThenActiveWindow.ActivePane.View.Type = wdPrintViewEnd IfWith ActiveDocument.PageSetup.TextColumns.SetCount NumColumns:=2.EvenlySpaced = True.LineBetween = False.Width = CentimetersToPoints(6.95).Spacing = CentimetersToPoints(0.75)End WithWith ActiveDocument.Styles(wdStyleNormal).FontIf .NameFarEast = .NameAscii Then.NameAscii = ""End If.NameFarEast = ""End WithWith ActiveDocument.PageSetup.LineNumbering.Active = False.Orientation = wdOrientLandscape.TopMargin = CentimetersToPoints(2.1).BottomMargin = CentimetersToPoints(2).LeftMargin = CentimetersToPoints(2).RightMargin = CentimetersToPoints(2).Gutter = CentimetersToPoints(0).HeaderDistance = CentimetersToPoints(1.5).FooterDistance = CentimetersToPoints(1.75).PageWidth = CentimetersToPoints(37).PageHeight = CentimetersToPoints(29).FirstPageTray = wdPrinterDefaultBin.OtherPagesTray = wdPrinterDefaultBin.SectionStart = wdSectionNewPage.OddAndEvenPagesHeaderFooter = False.DifferentFirstPageHeaderFooter = False.VerticalAlignment = wdAlignVerticalTop.SuppressEndnotes = False.MirrorMargins = False.TwoPagesOnOne = False.BookFoldPrinting = False.BookFoldRevPrinting = False.BookFoldPrintingSheets = 1.GutterPos = wdGutterPosLeft.LayoutMode = wdLayoutModeLineGridEnd WithIf ActiveWindow.View.SplitSpecial <> wdPaneNone ThenActiveWindow.Panes(2).CloseEnd IfIf ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ ActivePane.View.Type = wdOutlineView ThenActiveWindow.ActivePane.View.Type = wdPrintViewEnd IfActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeaderWith Selection.ParagraphFormat.Borders(wdBorderLeft).LineStyle = wdLineStyleNone.Borders(wdBorderRight).LineStyle = wdLineStyleNone.Borders(wdBorderTop).LineStyle = wdLineStyleNone.Borders(wdBorderBottom).LineStyle = wdLineStyleNoneWith .Borders.DistanceFromTop = 1.DistanceFromLeft = 4.DistanceFromBottom = 1.DistanceFromRight = 4.Shadow = FalseEnd WithEnd WithWith Options.DefaultBorderLineStyle = wdLineStyleSingle.DefaultBorderLineWidth = wdLineWidth050pt.DefaultBorderColor = wdColorAutomaticEnd WithIf ActiveWindow.View.SplitSpecial <> wdPaneNone ThenActiveWindow.Panes(2).CloseEnd IfIf ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ ActivePane.View.Type = wdOutlineView ThenActiveWindow.ActivePane.View.Type = wdPrintViewEnd IfActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeaderIf ActiveWindow.View.SplitSpecial <> wdPaneNone ThenActiveWindow.Panes(2).CloseEnd IfIf ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ ActivePane.View.Type = wdOutlineView ThenActiveWindow.ActivePane.View.Type = wdPrintViewEnd IfActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument' 手动换行改成回车换行Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWith Selection.Find.Text = "^l".Replacement.Text = "^p".Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll' 查找双回车换行替换成单回车符（删除单行）Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWith Selection.Find.Text = "^p^p".Replacement.Text = "^p".Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub如果删除单行功能不好，可以使用下面代码替换。

(完整word版)高中信息技术经典操作题VB代码

操作题部分VB代码注意：只能在function func（）和end function之间输入代码。

其他部分一律不许改动或删除.函数的返回值必须用函数名来返回，即代码中需要出现“func=***”的语句。

************************** ********************************* 1、输入一个整数，输出各位数字之和。

如：123，输出6Function func(n)Dim i As IntegerDim m As Integerm = Len(Str(n))func = 0For i = 1 To mfunc = func + Val(Mid(Str(n), i, 1))Next iEnd Function说明：str（）将数字转换为字符串，len（）求字符串的长度Mid（字串，起始位置，数量）从字串的指定位置截取指定长度的字串Val( ) 将字串转换为相应的数字************************** ********************************* 2、输入五位同学的身高，输出最高的数据Function func(a, b, c, d, e)func = aIf func < b Then func = bIf func < c Then func = cIf func < d Then func = dIf func < e Then func = eEnd Function************************** ********************************* 3、求2+4+……+100的和Function func（）Dim I as integerFunc=0For I = 2 to 100 step 2Func=func+iNext iEnd function************************** ******************************** 4、统计100-999之间水仙花数的个数（水仙花数：如：13+53+33=153）Function func（）Dim abc as integer, a as integer , b as integer , c as integer Func=0For abc=100 to 999a=abc\100b=(abc-a*100)\10c= abc mod 10if a^3+b^3+c^3=abc then func=func+1next abcend function说明：abc为三位数，a是百位数，b是十位数，c是个位数************************** ******************************** 5、某火车站运费标准如下：运输距离小于500公里，按照运费标准收费，运输距离大于等于500公里小于1000公里，按照运费标准给予0.05的折扣，运输距离大于等于1000公里小于3000公里，按照运费标准给予0.1的折扣，运输距离大于等于3000公里，按照求运费标准给予0.15的折扣。

(完整word版)高中信息技术经典操作题VB代码.doc

操作题部分VB 代码注意：只能在function func（）和end function 之间输入代码。

其他部分一律不许改动或删除.函数的返回值必须用函数名来返回，即代码中需要出现“func=*** ”的语句。

***********************************************************1、入一个整数，出各位数字之和。

如： 123，出 6 Functionfunc(n)Dim i As IntegerDim m As Integerm = Len(Str(n))func = 0For i = 1 To mfunc = func + Val(Mid(Str(n), i, 1))Next iEnd Function明： str（）将数字字符串，len（）求字符串的度Mid （字串，起始位置，数量）从字串的指定位置截取指定度的字串 Val( )将字串相的数字***********************************************************2、入五位同学的身高，出最高的数据Function func(a, b, c, d, e)func = aIf func < b Then func = bIf func < c Then func = cIf func < d Then func = dIf func < e Then func = eEnd Function***********************************************************3、求 2+4+⋯⋯ +100 的和Function func（）Dim I as integerFunc=0For I = 2 to 100step 2Func=func+iNext iEnd function************************** ********************************4、 100-999 之水仙花数的个数（水仙花数：如：13+53+33=153）Function func（）Dim abc as integer, a as integer , b as integer , c as integer Func=0For abc=100 to999a=abc\100b=(abc-a*100)\10c= abc mod10if a^3+b^3+c^3=abc then func=func+1next abcend function明： abc 三位数， a 是百位数， b 是十位数， c 是个位数************************** ********************************5、某火站运准如下：运距离小于500 公里，按照运准收，运距离大于等于 500 公里小于 1000 公里，按照运准予0.05 的折扣，运距离大于等于 1000 公里小于 3000 公里，按照运准予0.1 的折扣，运距离大于等于 3000 公里，按照求运准予0.15 的折扣。

用OFFICE+VBA实现WORD自动阅卷功能

用OFFICE VBA实现WORD自动阅卷功能受学生等级考试启发，经过不断努力，完成和等级考试一样的WORD文档自动阅卷功能程序，可以把它嵌入到VB中或直接在WORD中用“宏”来操作.以下为嵌入到VB中使用时的代码,若要利用宏来操作,只需进行简单修改即可:Set wrd = CreateObject("Word.Application")wrd.Visible = Falsewrd.Documents.Open "c:\ks\word.doc"'wrd.Documents("Word.doc").Activateerrstring = ""rightstring = ""With wrd.Documents("Word.doc").PageSetupIf .LeftMargin <> 79.4 Thenerrstring = errstring & "左边距错误" & vbCrLf '本行代码检测左边距2.8cm Elserightstring = rightstring & "左边距设置正确" & vbCrLfEnd IfIf .RightMargin <> 79.4 Thenerrstring = errstring & "右边距错误" & vbCrLf '本行代码检测右边距2.8cm Elserightstring = rightstring & "右边距设置正确" & vbCrLfEnd IfIf .TopMargin <> 85.05 Thenerrstring = errstring & "上边距错误" & vbCrLf '本行代码检测上边距3cm Elserightstring = rightstring & "上边距设置正确" & vbCrLfEnd IfIf .BottomMargin <> 85.05 Thenerrstring = errstring & "下边距错误" & vbCrLf '本行代码检测下边距3cm Elserightstring = rightstring & "下边距设置正确" & vbCrLfEnd IfIf .PaperSize <> wdPaperA4 Thenerrstring = errstring & "纸型设置错误" & vbCrLf '检测是否为A4Elserightstring = rightstring & "纸型设置正确" & vbCrLfEnd IfEnd WithDim doctablecount, i As IntegerDim str1 As Stringdoctablecount = wrd.Documents("Word.doc").Tables.CountWith wrd.Documents("Word.doc")If .Sections(1).PageSetup.Orientation <> wdOrientLandscape Thenerrstring = errstring & "页面方向设置错误" & vbCrLf '本行代码检测页面设置,wdOrientLandscape为横向，wdOrientPortrait为纵向Elserightstring = rightstring & "页面方向设置正确" & vbCrLfEnd If.ActiveWindow.View.Type = wdPrintView.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader '以上两行代码更改为页眉页脚视图If .Sections(1).Headers(wdHeaderFooterPrimary).Range.Text <> "恐龙博物馆" & vbCr Or .Sections(1).Headers(wdHeaderFooterPrimary).Range.Paragraphs.Alignment <> wdAlignParagraphRight Thenerrstring = errstring & "页眉设置错误" & vbCrLf '本行代码检测页眉文字及对齐方式Elserightstring = rightstring & "页眉设置正确" & vbCrLfEnd If.ActiveWindow.View.SeekView = wdSeekCurrentPageFooter'If .Sections(1).Footers(wdHeaderFooterFirstPage).Range.T ext <> "剑龙" & vbCr Or .Sections(1).Footers(wdHeaderFooterFirstPage).Range.Paragraphs.Alignment <> wdAlignParagraphCenter Then errstring = errstring & "页脚设置错误" & vbCrLf '本行代码检测页脚文字及对齐方式If .Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Count = 0 Then errstring = errstring & "没有在页脚中插入页码" & vbCrLfElseIf .Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers(1).Alignment <> wdAlignPageNumberCenter Thenerrstring = errstring & "插入页码错误" & vbCrLf '本行代码检测是否在页脚中插入居中页码Elserightstring = rightstring & "插入页码正确" & vbCrLfEnd If.ActiveWindow.View.SeekView = wdSeekMainDocument'以下代码剪切文档中的表格If doctablecount <> 0 ThenFor i = 1 To doctablecount.Tables(i).Range.CutNext iEnd If'以下代码检测浮动对象Dim etxteft, etxtbox, epic As Booleanetxteft = etxtbox = epic = FalseFor Each Sh1 In wrd.Documents("Word.doc").ShapesIf Sh1.Type = msoT extEffect ThenIf Sh1.TextEffect.Text <> "辽宁角龙" Thenerrstring = errstring & "艺术字设置错误" & vbCrLf '本行检测艺术字Elserightstring = rightstring & "艺术字设置正确" & vbCrLfEnd Ifetxteft = TrueEnd IfIf Sh1.Type = msoTextBox ThenIf Sh1.TextFrame.T extRange.Text <> "恐龙博物馆之一" & vbCr Or Sh1.T extFrame.Orientation <> 1 Thenerrstring = errstring & "文本框版式或文本框内文字错误" & vbCrLf '检测文本框及方向：msoTextOrientationHorizontal(1)横向；msoTextOrientationVertical(4)纵向。

VB调用WORD方法与实例代码

VB调用WORD方法与实例代码'=============打开word==============Function OpenWord(FileName)Dim wordApp As New Word.ApplicationDim wordDoc As New Word.DocumentSet wordApp = CreateObject("Word.Application")wordApp.Visible = FalseSet wordDoc = wordApp.Documents.Open(FileName) End Function'============替换关键字===========Function ReplaceWord(SearchStr, ReplaceStr)Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWith Selection.Find.Text = SearchStr.Replacement.Text = ReplaceStr .Forward = True .Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Function'============另存为===================Function SaveAsWord(DiskStr, NameStr)ChangeFileOpenDirectory DiskStrActiveDocument.SaveAs FileName:=NameStr,FileFormat:=wdFormatDocument, _LockComments:=False, Password:="", AddToRecentFiles:=True, _ WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= FalseApplication.Documents.CloseApplication.QuitEnd Function'===================清除对象============Function CloseWord()Set wordDoc = Nothing '清除文件实例Set wordApp = Nothing '清除WORD实例End Function'===================用VB调用WORD代码============Private Sub Form_Load()Dim wp As New Word.ApplicationDim wd As New Word.Documentwp.Visible = TrueSet wd = wp.Documents.Open("c:\22075847937.doc")Dim neirong As Stringneirong = wd.Content.TextMsgBox "该Word文件的内容为:" & vbNewLine & neirong End Sub。

二级计算机VB考试常用代码(看完必过)

二级计算机VB考试代码第一套1Private Sub Command1_Click() Dim sum As Longn = Val(Text1.Text) sum = 0 If n Mod 2 = 0 Then' m = ?Else' m = ?End If' For i = 1 To m Step ?' sum = sum + ? Next Label2.Caption = sum End Sub Private Function f(ByVal x As Integer) As Long y = 1' For i = 1 To ?y = y * i Next f = y End Function2Option Base 1Private Sub Command1_Click()Dim days%, month%, year%, day1_1%, n%Static month_days As Variantmonth_days = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)For k = 0 To 6If Option1(k).Value = True Thenday1_1 = kEnd IfNext k days = 0 month = Text2 year = Text1' month_days(2) = IIf(leap_year(year), 29, ? )'== 计算到要显示月历的月份之前共有多少天==' For k = ? To month - 1days = days + month_days(k) Next k'==== 计算要显示月历的月份的第1天是星期几=====n = (days Mod 7 + day1_1) Mod 7'================ 输出月历==================Picture1.ClsPicture1.Print " SUN MON TUE WED THU FRI SAT"For k = 1 To month_days(month)Picture1.Print Tab(5 * n + 1); k; n = n + 1If n = 7 Then Picture1.Print' n = ?End If Next k End Sub'============== 判断闰年=================='Private Function leap_year( ? As Integer) As Booleanleap_year = (year Mod 4 = 0 And year Mod 100 <> 0 Or year Mod 400 = 0)End FunctionPrivate Sub Option1_Click(Index As Integer) End Sub3Private Type recname As String * 3 Math As IntegerChinese As Integer English As Integer End TypeDim a(20) As rec, num As Integer, n As IntegerPrivate Sub readdata()Open App.Path & "\in5.txt" For Input As #1k = 1 Do While Not EOF(1)Input #1, a(k).name, a(k).Math, a(k).Chinese, a(k).Englishk = k + 1 Loop Close #1' num = ? End SubPrivate Sub Command1_Click()n = 1 putdata n End SubPrivate Sub Command2_Click() n = n + 1 putdata n End SubPrivate Sub Command3_Click()' n = ? putdata n End SubPrivate Sub Command4_Click()n = num putdata n End SubPrivate Sub Form_Load()Readdata Command1_Click End Sub'Private Sub putdata( ? As Integer)Label1.Caption = "第" & k & "条记录"Text1 = a(k).name Text2 = a(k).Math Text3 = a(k).Chinese Text4 = a(k).EnglishText5 = a(k).Math + a(k).Chinese + a(k).English' SetEnabled ? End SubPrivate Sub SetEnabled(m As Integer)Command1.Enabled = IIf(m = 1, False, True)Command2.Enabled = IIf(m = num, False, True)Command3.Enabled = IIf(m = 1, False, True)' Command4.Enabled = IIf( ? ) End Sub第二套1Private Sub Form_Load()Command1.Caption = "开始" Command2.Caption = "停止"Timer1.Interval = 100 Timer1.Enabled = False End SubPrivate Sub Command1_Click()'Command1.Caption = ? Timer1.Enabled = True'Command1.Enabled = ? Command2.Enabled = TrueEnd SubPrivate Sub Command2_Click()Timer1.Enabled = False Command2.Enabled = False'Command1.Enabled = ?End SubPrivate Sub Timer1_Timer()If HScroll1.Value < HScroll1.Max Then'HScroll1.Value = ?Else'HScroll1.Value = ?End IfEnd Sub2Private Sub Command1_Click()'st1 = Trim( ? )n = 1 st2 = UCase(Left(st1, 1))Do While n <= Len(st1) If Mid(st1, n, 1) <> " " Then'st2 = ? & Mid(st1, n + 1, 1) n = n + 1 End IfIf Mid(st1, n, 1) = " " Thenst2 = st2 & UCase(Mid(st1, n + 1, 1))n = n + 1End IfLoop'Text2.Text = ?End Sub3Function prime(ByVal n As Integer) As Boolean' ****** 考生编写******' ************************End FunctionPrivate Sub Form_Click()' ****** 考生编写******' ************************Open App.Path & "\out5.txt" For Output As #1Print #1, Text1.TextClose 1End Sub第三套1Private Sub Dir1_Change()' File1.Path = ?End SubPrivate Sub Drive1_Change()' Dir1.Path = ?End SubPrivate Sub File1_Click()Label2.Caption = File1.FileNameEnd SubPrivate Sub Option1_Click(Index As Integer)' If ? = 0 ThenDrive1.Drive = "c:\"File1.Pattern = "*.*"Else' File1.Pattern = ?End IfEnd Sub2Dim a(5, 5) As StringPrivate Sub Command1_Click()Dim s As StringRandomizeFor i = 1 To 5For j = 1 To 5a(i, j) = Chr(Rnd * (90 - 65) + 65) ' s = s + ? + " "Nexts = s & Chr(13) & Chr(10)Next' Text1 = ?End SubPrivate Sub Command2_Click()MaxI = 1MaxJ = 1Max = Asc(a(1, 1))For i = 1 To 5For j = 1 To 5' If ? > Max ThenMax = Asc(a(i, j))MaxI = iMaxJ = jEnd IfNextNext' Text2 = Chr( ? ) & Str(MaxI) & Str(MaxJ)End Sub3Dim a(5, 5) As LongDim b(5, 5) As LongPrivate Sub Command1_Click()' Open App.Path & "\in5.txt" For ? As #1For i = 1 To 5For j = 1 To 5' Input #1, ?s = s + Str(a(i, j))Nexts = s + Chr(13) + Chr(10)NextText1 = s' ?End SubPrivate Sub Command2_Click()'===============以下由考生编写================='===========考生编写程序结束====================== End SubPrivate Sub Command3_Click()'=======以下由考生编写==========================='============考生编写程序结束========================= Open App.Path & "\out5.txt" For Output As #1Print #1, Label2.CaptionClose #1End Sub第四套1Private Sub Command1_Click()RandomizeText2.Locked = FalseText1 = "": Text2 = "": text3 = ""For i = 1 To 20s = Chr$(Int(Rnd * 26) + 97)'Text1 = Text1 + ?NextEnd SubPrivate Sub Text2_KeyPress(KeyAscii As Integer)Dim m As Integer, n As IntegerIf Len(Text2) = 20 Then' Text2.Locked = ?m = 0: n = 0For i = 1 To 20' If Mid(Text2, i, 1) = ? Then' m = ?Else' n = ?End IfNexttext3 = m / (m + n) * 100 & "%"End IfEnd SubPrivate Sub Command2_Click()EndEnd Sub2Option Base 1Dim stu(1 To 50) As StudTypeDim n%Private Sub Cmd1_Click(Index As Integer)' Select Case ?Case 0If n < 50 Then' n = ?stu(n).Num = Text1stu(n).Name = Text2stu(n).Total = Text3Text1 = "": Text2 = "": Text3 = ""Label4.Caption = "已输入" & Space(1) & n & Space(1) & "人"ElseMsgBox "输入人数已超过50!"End IfCase 1' Max = ?maxi = 1For j = 2 To n' If stu(j).Total > ? ThenMax = stu(j).Total' maxi = ?End IfNextText1 = stu(maxi).NumText2 = stu(maxi).NameText3 = stu(maxi).TotalLabel4.Caption = "位置：" & Space(2) & maxi & "/" & n Case 2EndEnd SelectEnd SubOption Base 1Dim a(20, 6) As IntegerPrivate Sub Command1_Click()Open App.Path & "\in5.dat" For Input As #1For i = 1 To 20For j = 1 To 6Input #1, a(i, j)Text1 = Text1 + Str(a(i, j)) + Space(1)Next jText1 = Text1 + Chr(13) + Chr(10)Next iClose #1End SubPrivate Sub Command2_Click()'============以下由考生编写=========================== '==========考生编写程序结束========================= End SubPrivate Sub Form_Unload(Cancel As Integer)Open App.Path & "\out5.dat" For Output As #1Print #1, Text2.TextClose #1End Sub第五套1Private Sub Command1_Click()Randomize' For k = ? To 9' ? = Int(Rnd * 90 + 10)Next kEnd SubPrivate Sub Command2_Click()' For k = 0 To ?temp = Label1(k).CaptionLabel1(k).Caption = Label1(9 - k).Caption' ? = tempNext kEnd Sub2Dim r%, x0%, y0, aPrivate Sub Command1_Click()Timer1.Enabled = TrueEnd SubPrivate Sub Form_Load()r = Shape1.Width / 2' x0 = ? + ry0 = Shape1.Top + r' Image1.Left = x0 - ?Image1.Top = y0 - r - Image1.Height / 2a = 90End SubPrivate Sub Timer1_Timer()Dim x, ya = a - 3x = x0 + r * Cos(a * 3.14159 / 180)y = y0 - r * Sin(a * 3.14159 / 180)' Image1.Left = ? - Image1.Width / 2' Image1.Top = ? - Image1.Height / 2End Sub3Private Sub Command1_Click()Open "in5.dat" For Input As #1n = LOF(1)' ch$ = Input(n, ? )Close #1Text1.Text = chEnd SubPrivate Sub Command2_Click()Dim IsSpace As Booleanch1$ = Text1.Text' n = Len( ? )IsSpace = TrueFor k = 1 To n' c = Mid(ch1, k, ? )If c = " " Then '双引号中是一个空格符IsSpace = TrueElseIf IsSpace Thenc = UCase(c)IsSpace = FalseEnd IfEnd If' ch2$ = ch2$ & ?Next kText1.Text = ch2End SubPrivate Sub Command3_Click()Open "out5.dat" For Output As #1Print #1, Text1.TextClose #1End Sub第六套1Private Sub Command1_Click()str1 = Text1.Textstr2 = Text2.Text' n = Len(?)' For i = 1 To Len(?)If Mid(str1, i, n) = RTrim(str2) Then' MsgBox str2 & "的起始位置是：" & ?Exit ForEnd IfNext' If i > ? Then MsgBox "没有找到!"End SubPrivate Sub Form_Load()Text1.Text = "Last week I went to the theatre. I had a good seat. The play is very interesting. I did not enjoy it. A young man and a young woman were seating behind me. They were talking loudly."End Sub2Private Sub showPic_Click()Picture1.Visible = TrueText1.Visible = False' If ? = "显示图片" ThenPicture1.Picture = LoadPicture(App.Path & "\pic4.bmp")showPic.Caption = "清空图片"Else' Picture1.Picture = ?showPic.Caption = "显示图片"End IfEnd SubPrivate Sub showText_Click()' Picture1.Visible = ?Text1.Visible = True' Open App.Path & "\data4.dat" ? As #1Input #1, s' Text1.Text = ?Close #1End Sub3Private Sub Command1_Click()Open App.Path & "\data5.dat" For Input As #1Input #1, x' Label1.Caption = ?' Close ?End SubPrivate Sub Command2_Click()'=========以下考生编写=============================== '=======考生编写程序结束============================ Open App.Path & "\out5.dat" For Output As #1Print #1, Label2.CaptionClose #1End SubPrivate Function p(n As Integer) As Booleanflag = TrueFor i = 2 To Sqr(n)If n Mod i = 0 Thenflag = FalseExit ForEnd IfNext ip = flagEnd Function第七套1Private Sub Command1_Click()For i = 0 To 6' k = ?' For j = i + 1 To ?' If Val(Text1(j).Text) > ? Thenk = jEnd IfNext jj = Text1(i).TextText1(i).Text = Text1(k).Text' Text1(k).Text = ?Next iEnd Sub2Private Sub Command1_Click()For k = 0 To Combo1.ListCount - 1' If Combo1.Text = ? ThenExit ForEnd IfNext kIf k >= Combo1.ListCount Then' Combo1.AddItem ?ElseMsgBox ("此项目已存在！")End IfEnd SubPrivate Sub Command2_Click()If Combo1.ListIndex >= 0 Then' Combo1.RemoveItem ?End IfEnd SubPrivate Sub Command3_Click()' Text1.Text = Text1.Text & " " & ?End SubPrivate Sub Command4_Click()' ? = ""End Sub3Option Base 1Dim s As StringPrivate Sub Command1_Click()Open App.Path & "\in5.dat" For Input As #1s = Input(LOF(1), #1)Close #1Text1.Text = sEnd SubPrivate Function GetWords(s As String, words() As String) As IntegerDim m%, ch$ch = ""For k = 1 To Len(s)c = Mid(s, k, 1)If c <> " " Thench = ch + cElsem = m + 1words(m) = chch = ""End IfNext k' GetWords = ?End FunctionPrivate Sub Command2_Click()Dim ch(800) As String, n As IntegerIf Len(s) = 0 ThenMsgBox "请先使用“读数据”功能！"Else' m = GetWords( ? , ch )'--------------------------考生编写的程序代码从这里开始'--------------------------考生编写的程序代码到这里结束End IfEnd SubPrivate Sub Form_Unload(Cancel As Integer)Open App.Path & "\out5.dat" For Output As #1Print #1, Label1.CaptionClose #1End Sub第八套Private Sub Command1_Click()Dim s As LongDim i As Integeri = 0: s = 0'While i < ?' ?s = s + jc(i)WendText1.Text = sEnd SubFunction jc(n As Integer) As LongDim i As IntegerDim t As Long' ?'For i = 1 To ?t = t * iNext' ?End Function2Option Base 1Private Sub Command1_Click()Dim arr(50) As IntegerDim i As Integer, j As IntegerDim x As Integer, max As Integer, pos As IntegerRandomizemax = 0: pos = 1i = 1Dox = Int(Rnd * 101)' ?Do While j < iIf x <> arr(j) Then' j = j + ?ElseExit DoEnd IfLoopIf j = i Then'arr(j) = ?Print arr(j);i = i + 1If (i - 1) Mod 10 = 0 Then PrintIf max < x Thenmax = x' pos = ?End IfEnd IfLoop Until i > 50Text1.Text = maxText2.Text = posEnd Sub3Dim a(100) As IntegerPrivate Sub Command1_Click()Dim k As IntegerOpen App.Path & "\in5.dat" For Input As #1For k = 1 To 100Input #1, a(k)Next kClose #1End SubPrivate Sub Command2_Click()Dim i As Integer, j As IntegerDim b(100) As Integerj = 0For i = 1 To 100If prime(a(i)) Thenj = j + 1b(j) = a(i)End IfNextFor i = 1 To jText1 = Text1 + Str(b(i))NextEnd Sub'以下Function 过程用于判断某数是否为质数Function prime(p As Integer) As Boolean'考生编写End FunctionPrivate Sub Form_Unload(Cancel As Integer) Open App.Path & "\out5.dat" For Output As #1Print #1, Text1.TextClose #1End Sub第九套Dim n As IntegerPrivate Sub Form_Click()' Timer1.Enabled = ?End SubPrivate Sub Form_Load()' Timer1.Interval = ?Timer1.Enabled = FalseText1.ForeColor = 0n = 0End SubPrivate Sub Timer1_Timer()' n = ?If n Mod 5 = 0 ThenText1.Text = Time()End IfIf n Mod 8 = 0 Then' If Text1.ForeColor = ? ThenText1.ForeColor = &HFFElseText1.ForeColor = 0End IfEnd IfEnd Sub2Dim a%(1 To 10)Private Sub Command1_Click()RandomizeFor k = 1 To 10a(k) = Int(Rnd * 90 + 10)Picture1.Print a(k);Next kPicture1.PrintPicture1.Print "---------------------------------------" End SubPrivate Sub Command2_Click()m% = Val(Text1)' MoveArray a(), ?For k = 1 To 10Picture1.Print a(k);Next kPicture1.PrintEnd SubSub MoveArray(a() As Integer, m As Integer)n% = UBound(a)' For k = 1 To ?x = a(1)For j = 1 To n - 1' a(j) = a( ? )Next j' a(n) = ?Next kEnd Sub3Private Type recname As String * 3Math As IntegerChinese As IntegerEnglish As IntegerEnd TypeDim a(30) As rec, num As IntegerPrivate Sub Command1_Click()Open App.Path & "\in5.txt" For Input As #1k = 1' Do While Not EOF( ? )Input #1, a(k).name, a(k).Math, a(k).Chinese, a(k).Englishk = k + 1LoopClose #1' num = ?End SubPrivate Sub Command2_Click()'========================考生编写====================== '====================================================== End SubPrivate Sub Command3_Click()Open App.Path & "\out5.dat" For Output As #1For k = 1 To numPrint #1, a(k).nameNext kClose #1End SubPrivate Function sum(k As Integer) As Integersum = a(k).Math + a(k).Chinese + a(k).EnglishEnd Function第十套Private Sub Command1_Click()' If ? Or File1.ListIndex = File1.ListCount - 1 Then File1.ListIndex = 0ElseIf File1.ListIndex >= 0 Then' File1.ListIndex = ?End IfEnd IfShowInforEnd SubPrivate Sub File1_DblClick()Call ShowInforEnd SubPrivate Sub ShowInfor()' Label1.Caption = App.Path + "\" + ?Image1.Picture = LoadPicture(Label1.Caption)End SubPrivate Sub Form_Load()File1.Path = App.Path' File1. ?End Sub2Private Sub Command1_Click()Dim fstr As String, ostr As StringDim times As Integer, pos As IntegerDim ans As Integerfstr = InputBox("输入待查内容", "查找")If fstr = "" ThenExit SubEnd Iftimes = 0ostr = Text1.Textpos = InStr(1, ostr, fstr)Do While pos <> 0' Text1.SelStart = ?' Text1.SelLength = ?' times = ?Text2.Text = timesans = MsgBox("找到了，是否继续查找？", vbYesNo)If ans = vbYes Thenpos = pos + Len(fstr)' pos = ?ElseExit DoEnd IfLoopEnd Sub3Option ExplicitOption Base 1Dim a(10) As IntegerPrivate Sub Command1_Click()Dim i As IntegerList1.ClearOpen App.Path & "\in5.dat" For Input As #1For i = 1 To 10Input #1, a(i)List1.AddItem (a(i))Next iClose #1End Sub强化31Private Sub Command2_Click()'===================考生编写的程序============== '=============================================== End SubPrivate Sub Command3_Click()Dim i As IntegerOpen App.Path & "\out5.dat" For Output As #1For i = 0 To 9Print #1, List2.List(i)Next iClose #1End SubPrivate Sub C1_Click()Dim k As Integer' Form2. ?Form2.Print Form1.L1.Caption; Form1.Text1Form2.Print Form1.L2.Caption; Form1.Text2Form2.Print Form1.L3.Caption; Form1.Text3' Form2.Print Form1.Frame1. ? ; "：";For k = 0 To 1' If Form1.Op1( ? ).Value ThenForm2.Print Form1.Op1(k).CaptionEnd IfNext kEnd SubPrivate Sub Form_Load()' Text2. ? = "*"End Sub2Private Sub C1_Click()' If ? = "123456" ThenText1.Text = "口令正确"' Text1.? = ""ElseText2.Text = Text2.Text - 1' If Text2.Text > ? ThenMsgBox "第" & (3 - Text2.Text) & "次口令错误，请重新输入"ElseMsgBox "3次输入错误，请退出"' Text1.Enabled = ?End IfEnd IfEnd Sub强化32Private Sub Form_load()HScroll1.Min = Shape2.Left' HScroll1.Max = Shape2.Width + Shape2.Left - Shape1. ?VScroll1.Min = Shape2.Top' VScroll1.Max = Shape2.Height + ? - Shape1.HeightHScroll1.Value = 1000VScroll1.Value = 1000End SubPrivate Sub HScroll1_Change()' ? = HScroll1.ValueEnd SubPrivate Sub VScroll1_Change()' Shape1.Top = ?End Sub2Dim a, t, dPrivate Sub Command1_Click()' Timer1.? = Trued = Image1.TopEnd SubPrivate Sub Command2_Click()Open App.Path & "\out4.txt" For Output As #1Print #1, Label1, Label2Close #1End SubPrivate Sub Form_Load()a = 1t = 0End SubPrivate Sub Timer1_Timer()Image1.Top = Image1.Top - a * 50If Image1.Top + Image1.Height <= Image2.Top + Image2.Height - 200 Then' ? = False' d = ? - Image1.TopLabel1 = dLabel2 = t * Timer1.Interval / 1000End Ifa = a + 0.1' t = ?End Sub3Dim a(30) As Integer, b(30) As Integer, c(60) As IntegerPrivate Sub Command1_Click()Dim k As IntegerOpen App.Path & "\in5.dat" For Input As #1For k = 1 To 30Input #1, a(k)Text1 = Text1 + Str(a(k)) + Space(2) Next kFor k = 1 To 30Input #1, b(k)Text2 = Text2 + Str(b(k)) + Space(2) Next kClose #1End Sub'考生编写程序Private Sub Command2_Click()For k = 1 To 60Text3 = Text3 + Str(c(k)) + Space(2) Next kEnd SubPrivate Sub Form_Unload(Cancel As Integer)Open App.Path & "\out5.dat" For Output As #1Print #1, Text3.TextClose #1End Sub强化33Private Sub Command1_Click()Dim n As IntegerCls' ? = InputBox("请输入一个整数")Print "因子数="; fun(n)End SubFunction fun(m As Integer)Dim s As Integers = 0For k = 1 To Abs(m) / 2' If m Mod k = ? Thens = s + 1Print kEnd IfNext k' ?End Function2Private Sub Command1_Click()Dim k%' For k = List1.ListCount - 1 To 0 ?If List1.Selected(k) = True Then' List2.AddItem ?' List1.RemoveItem ?End IfNext kEnd SubPrivate Sub Command2_Click()Dim k%Text1 = "已经选中的城市有："For k = 0 To List2.ListCount - 1 Step 1' Text1 = ? & " " & List2.List(k)Next kEnd Sub3Dim stepy As Integer '纵向移动增量Dim stepx As Integer '横向移动增量Const LEFT_BUTTON = 1Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)Dim x0 As Integer, y0 As Integer, a As Single, radius As Integerradius = Shape1.Width / 2 '圆的半径If Button = LEFT_BUTTON Thenx0 = Shape1.Left + radius '圆心的x坐标y0 = Shape1.Top + radius '圆心的y坐标If x = x0 Thenstepy = Sgn(y - y0) * 50' stepx = ?Elsea = (y - y0) / (x - x0) '斜率stepx = Sgn(x - x0) * 50' ? = a * stepxIf Abs(stepy) > Abs(stepx) Thenstepy = Sgn(y - y0) * 50stepx = stepy / aEnd IfEnd If' ? = TrueElse' ? = FalseEnd IfEnd SubPrivate Sub Timer1_Timer()' Shape1.Move Shape1.Left + stepx, Shape1.Top + ? End Sub强化34Dim a(10) As IntegerPrivate Sub Form_Load()For i = 1 To 10a(i) = Int(Rnd * 100)NextEnd SubPrivate Sub Command1_Click()x = a(1)y = a(1)For i = 2 To 10If Option1.Value = True Then' If a(i) ? x Then' ?= a(i)End If' ElseIf a(i) ? y Then' ?= a(i)End IfNextIf Option1.Value = True ThenLabel2.Caption = xElseLabel2.Caption = yEnd IfEnd Sub2Private Sub List1_DblClick()' Call MoveItem(?)End SubPrivate Sub Command1_Click()Call MoveAllEnd SubPublic Sub MoveItem(L1 As ListBox, L2 As ListBox) ' L2.AddItem ?' L1.RemoveItem ?End SubPublic Sub MoveAll()' For i = 0 To ?List2.AddItem List1.List(i)NextEnd Sub3Dim a(7, 7) As IntegerPrivate Sub Form_Load()readEnd SubPublic Sub read()Open App.Path & "\Data5.txt" For Input As #1Do While Not EOF(1)For i = 1 To 7For j = 1 To 7Input #1, a(i, j)Next jNext iLoopClose #1End SubPublic Sub Save()Open App.Path & "\out5.txt" For Output As #1Print #1, lblFirst.Caption, lblSecond.CaptionClose #1End SubPrivate Sub Command1_Click()Dim Sum As LongN = 7Counter = 0Sum = 0' 考生输入代码开始' 考生输入代码结束SaveEnd Sub强化35Private Sub Command1_Click()Dim n As IntegerDim b As IntegerDim a(3) As Integers = RTrim(Text1.Text)'n = ? (Text1.Text)For i = 1 To n'b = ? (Mid(s, i, 1))'Select Case ?Case 48 To 57a(0) = a(0) + 1Case 65 To 90a(1) = a(1) + 1Case 97 To 122a(2) = a(2) + 1End SelectNext'For i = 0 To ?'? = a(i)NextEnd Sub2Private Sub remove(La As ListBox, Lb As ListBox) ' For i = 0 To ? - 1' Lb.AddItem ?.List(i)Next' ?.ClearEnd SubPrivate Sub Command1_Click()Call remove(List1, List2)End SubPrivate Sub Command2_Click()Call remove(List2, List1)End Sub3Dim a(10) As IntegerPublic Sub Save()Open App.Path & "\out5.txt" For Output As #1Print #1, Label4.CaptionClose #1End SubPrivate Sub Command1_Click()Open App.Path & "\Data5.txt" For Input As #1 ' Do While Not ?For i = 1 To 10Input #1, a(i)' s = s & ?Next iLoopClose #1Label2.Caption = sEnd SubPrivate Sub Command2_Click()For i = 1 To 10s = s & Str(a(i))Next iLabel4.Caption = sSaveEnd Sub。

教你如何以VB对word 文件进行读写操作

VB6.0 如何对word 文件进行读写操作•对于这样的表格我通过下面一段代码可以实现，但如何对图二最下面的内容进行填充谢谢啦Set WordObj = CreateObject("Word.Application")WordObj.Visible = FalseIf wordfilepath = "" ThenMsgBox "请先打开文件！"Exit SubEnd IfSet myword = WordObj.Documents.Open(wordfilepath)strText = ActiveDocument.Words(1).Text'ActiveDocument.Words(1).Text = "Hello"With myword.Tables(1) .Cell(7, 2).Range.Text = "22"End Withmyword.CloseWordObj.Quit图一图二•百度下很多的，下面是我以前用的方法，要样板首先在要修改的word样板中要修改的地方随便写几个字（我写的是标记）作为标志，然后选中这些字，点工具插入mark，记住你起的名字（我起的是标记），然后参考以下代码。

Dim wd As New Word.ApplicationDim doc As Word.Documentwd.Visible = FalseSet doc = wd.Documents.Add(App.Path & "\样板.doc") '当模板用add,否则用open doc.Bookmarks("标记").Range.Text = "这里写你要输入的文字"doc.SaveAs "样板1.doc"doc.Closewd.Quit。

VBNET操作word文档代码

操作WORD(VBA)操作WORD1Public Class WordOpLib234 Private oWordApplic As Word.ApplicationClass5 Private oDocument As Word.Document6 Private oRange As Word.Range7 Private oShape As Word.Shape8 Private oSelection As Word.Selection91011 Public Sub New()12 '激活com word接口13 oWordApplic = New Word.ApplicationClass14 oWordApplic.Visible = False1516 End Sub17 '设置选定文本18 Public Sub SetRange(ByVal para As Integer)19 oRange = oDocument.Paragraphs(para).Range20 oRange.Select()21 End Sub22 Public Sub SetRange(ByVal para As Integer, ByVal sent As Integer)23 oRange = oDocument.Paragraphs(para).Range.Sentences(sent)24 oRange.Select()25 End Sub26 Public Sub SetRange(ByVal startpoint As Integer, ByVal endpoint As Integer, ByVal flag As Boolean)27 If flag = True Then28 oRange = oDocument.Range(startpoint, endpoint)29 oRange.Select()30 Else3132 End If33 End Sub3435 '生成空的新文档36 Public Sub NewDocument()37 Dim missing = System.Reflection.Missing.Value38 Dim isVisible As Boolean = True39 oDocument = oWordApplic.Documents.Add(missing, missing, missing, missing)40 oDocument.Activate()41 End Sub42 '使用模板生成新文档43 Public Sub NewDocWithModel(ByVal FileName As String)44 Dim missing = System.Reflection.Missing.Value45 Dim isVisible As Boolean = False46 Dim strName As String47 strName = FileName48 oDocument = oWordApplic.Documents.Add(strName, missing, missing, isVisible)49 oDocument.Activate()50 End Sub51 '打开已有文档52 Public Sub OpenFile(ByVal FileName As String)53 Dim strName As String54 Dim isReadOnly As Boolean55 Dim isVisible As Boolean56 Dim missing = System.Reflection.Missing.Value5758 strName = FileName59 isReadOnly = False60 isVisible = True6162 oDocument = oWordApplic.Documents.Open(strName, missing, isReadOnly, missing, missing, missing, missing, missing, missing, missing, missing, isVisible, missing, missing, missing, missing)63 oDocument.Activate()6465 End Sub66 Public Sub OpenFile(ByVal FileName As String, ByVal isReadOnly As Boolean)67 Dim strName As String68 Dim isVisible As Boolean69 Dim missing = System.Reflection.Missing.Value7071 strName = FileName72 isVisible = True7374 oDocument = oWordApplic.Documents.Open(strName, missing, isReadOnly, missing, missing, missing, missing, missing, missing, missing, missing, isVisible, missing, missing, missing, missing)75 oDocument.Activate()76 End Sub77 '退出Word78 Public Sub Quit()79 Dim missing = System.Reflection.Missing.Value80 oWordApplic.Quit()81 System.Runtime.InteropServices.Marshal.ReleaseComObject(oWordApplic)82 oWordApplic = Nothing83 End Sub84 '关闭所有打开的文档85 Public Sub CloseAllDocuments()86 oWordApplic.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)87 End Sub88 '关闭当前的文档89 Public Sub CloseCurrentDocument()9091 oDocument.Close(Word.WdSaveOptions.wdDoNotSaveChanges)92 End Sub93 '保存当前文档94 Public Sub Save()95 Try96 oDocument.Save()97 Catch98 MsgBox(Err.Description)99 End Try100 End Sub101 '另存为文档102 Public Sub SaveAs(ByVal FileName As String)103 Dim strName As String104 Dim missing = System.Reflection.Missing.Value105106 strName = FileName107108 oDocument.SaveAs(strName, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)109 End Sub110 '保存为Html文件111 Public Sub SaveAsHtml(ByVal FileName As String)112 Dim missing = System.Reflection.Missing.Value113 Dim strName As String114115 strName = FileName116 Dim format = CInt(Word.WdSaveFormat.wdFormatHTML)117118 oDocument.SaveAs(strName, format, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)119 End Sub120 '插入文本121 Public Sub InsertText(ByVal text As String)122 oWordApplic.Selection.TypeText(text)123 End Sub124 '插入一个空行125 Public Sub InsertLineBreak()126 oWordApplic.Selection.TypeParagraph()127 End Sub128 '插入指定行数的空行129 Public Sub InsertLineBreak(ByVal lines As Integer)130 Dim i As Integer131 For i = 1 To lines132 oWordApplic.Selection.TypeParagraph()133 Next134 End Sub135 '插入表格136 Public Sub InsertTable(ByRef table As DataTable)137 Dim oTable As Word.Table138 Dim rowIndex, colIndex, NumRows, NumColumns As Integer139 rowIndex = 1140 colIndex = 0141 If (table.Rows.Count = 0) Then142 Exit Sub143 End If144145 NumRows = table.Rows.Count + 1146 NumColumns = table.Columns.Count147 oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)148149150 '初始化列151 Dim Row As DataRow152 Dim Col As DataColumn153 'For Each Col In table.Columns154 ' colIndex = colIndex + 1155 ' oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)156 'Next157158 '将行添入表格159 For Each Row In table.Rows160 rowIndex = rowIndex + 1161 colIndex = 0162 For Each Col In table.Columns163 colIndex = colIndex + 1164 oTable.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))165 Next166 Next167 oTable.Rows(1).Delete()168 oTable.AllowAutoFit = True169 oTable.ApplyStyleFirstColumn = True170 oTable.ApplyStyleHeadingRows = True171172 End Sub173 '插入表格(修改为在原有表格的基础上添加数据)174 Public Sub InsertTable2(ByRef table As DataTable, ByVal strbmerge As String, ByVal totalrow As Integer)175 Dim oTable As Word.Table176 Dim rowIndex, colIndex, NumRows, NumColumns As Integer177 Dim strm() As String178 Dim i As Integer179 rowIndex = 1180 colIndex = 0181182 If (table.Rows.Count = 0) Then183 Exit Sub184 End If185186 NumRows = table.Rows.Count + 1187 NumColumns = table.Columns.Count188 'oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)189190191 '初始化列192 Dim Row As DataRow193 Dim Col As DataColumn194 'For Each Col In table.Columns195 ' colIndex = colIndex + 1196 ' oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)197 'Next198199 '将行添入表格200 For Each Row In table.Rows201 colIndex = 0202 GotoRightCell()203 oWordApplic.Selection.InsertRows(1)204 For Each Col In table.Columns205 GotoRightCell()206 colIndex = colIndex + 1207 Try208 oWordApplic.Selection.TypeText(Row(Col.ColumnName))209 Catch ex As Exception210 oWordApplic.Selection.TypeText(" ")211 End Try212 'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))213 Next214 Next215 '如果strbmerge不为空.则要合并相应的行和列216 If strbmerge.Trim().Length <> 0 Then217 strm = strbmerge.Split(";")218 For i = 1 To strm.Length - 1219 If strm(i).Split(",").Length = 2 Then220 MergeDouble(totalrow, strm(0), strm(i).Split(",")(1), strm(i).Split(",")(0))221 End If222 MergeSingle(totalrow, strm(0), strm(i))223 Next224 End If225 '删除可能多余的一行226 'GotoRightCell()227 'GotoDownCell()228 'oWordApplic.Selection.Rows.Delete()229 'oTable.AllowAutoFit = True230 'oTable.ApplyStyleFirstColumn = True231 'oTable.ApplyStyleHeadingRows = True232 End Sub233 '插入表格(专门适应工程结算工程量清单)234 Public Sub InsertTableQD(ByRef table As DataTable, ByRef table1 As DataTable)235 Dim oTable As Word.Table236 Dim rowIndex, colIndex, NumRows, NumColumns As Integer237 Dim xmmc As String238 Dim i As Integer239 Dim j As Integer240 rowIndex = 1241 colIndex = 0242243 If (table.Rows.Count = 0) Then244 Exit Sub245 End If246247 NumRows = table.Rows.Count + 1248 NumColumns = table.Columns.Count249 'oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows,NumColumns)250251252 '初始化列253 Dim Row As DataRow254 Dim rowtemp As DataRow255 Dim row1() As DataRow256 Dim Col As DataColumn257 Dim coltemp As DataColumn258 'For Each Col In table.Columns259 ' colIndex = colIndex + 1260 ' oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)261 'Next262263 '将行添入表格264 For Each Row In table.Rows265 colIndex = 0266 xmmc = Row("项目名称")267 GotoRightCell()268 oWordApplic.Selection.InsertRows(1)269 For Each Col In table.Columns270 GotoRightCell()271 Try272 If (Col.ColumnName = "项目序号") Then273oWordApplic.Selection.TypeText(intToUpint(Val(Row(Col.ColumnName))))274 Else275 oWordApplic.Selection.TypeText(Row(Col.ColumnName))276 End If277 Catch ex As Exception278 oWordApplic.Selection.TypeText(" ")279 End Try280 'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))281 Next282 row1 = table1.Select("项目名称='" + xmmc + "'")283284 For i = 0 To row1.Length - 1285 GotoRightCell()286 oWordApplic.Selection.InsertRows(1)287 For j = 0 To table1.Columns.Count - 1288 If (table1.Columns(j).ColumnName <> "项目名称") Then289 GotoRightCell()290 Try291 oWordApplic.Selection.TypeText(row1(i)(j))292 Catch ex As Exception293 oWordApplic.Selection.TypeText(" ")294 End Try295 End If296 'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))297 Next298 Next299300301302 Next303 '删除可能多余的一行304 'GotoRightCell()305 'GotoDownCell()306 'oWordApplic.Selection.Rows.Delete()307 'oTable.AllowAutoFit = True308 'oTable.ApplyStyleFirstColumn = True309 'oTable.ApplyStyleHeadingRows = True310 End Sub311 '插入表格,为了满足要求,在中间添加一根竖线312 Public Sub InsertTable3(ByRef table As DataTable, ByVal introw As Integer, ByVal intcol As Integer)313 Dim rowIndex, colIndex, NumRows, NumColumns As Integer314 Dim Row As DataRow315 Dim Col As DataColumn316 If (table.Rows.Count = 0) Then317 Exit Sub318 End If319 '首先是拆分选中的单元格320 oDocument.Tables(1).Cell(introw, 3).Split(table.Rows.Count, 2)321 '选中初始的单元格322 oDocument.Tables(1).Cell(introw, 3).Select()323 '将行添入表格324 For Each Row In table.Rows325 Try326 oDocument.Tables(1).Cell(introw, 3).Range.InsertAfter(Row(0))327 oDocument.Tables(1).Cell(introw, 4).Range.InsertAfter(Row(1))328 Catch ex As Exception329 oDocument.Tables(1).Cell(introw, 3).Range.InsertAfter(" ")330 oDocument.Tables(1).Cell(introw, 4).Range.InsertAfter(" ")331 End Try332 introw = introw + 1333 Next334 End Sub335 '设置对齐336 Public Sub SetAlignment(ByVal strType As String)337 Select Case strType338 Case "center"339 oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter340 Case "left"341 oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft342 Case "right"343 oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphRight344 Case "justify"345 oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphJustify346 End Select347 End Sub348 '设置字体349 Public Sub SetStyle(ByVal strFont As String)350 Select Case strFont351 Case "bold"352 oWordApplic.Selection.Font.Bold = 1353 Case "italic"354 oWordApplic.Selection.Font.Italic = 1355 Case "underlined"356 oWordApplic.Selection.Font.Subscript = 1357 End Select358 End Sub359 '取消字体风格360 Public Sub DissableStyle()361 oWordApplic.Selection.Font.Bold = 0362 oWordApplic.Selection.Font.Italic = 0363 oWordApplic.Selection.Font.Subscript = 0364 End Sub365 '设置字体字号366 Public Sub SetFontSize(ByVal nSize As Integer)367 oWordApplic.Selection.Font.Size = nSize368 End Sub369 '跳过本页370 Public Sub InsertPageBreak()371 Dim pBreak As Integer372 pBreak = CInt(Word.WdBreakType.wdPageBreak)373 oWordApplic.Selection.InsertBreak(pBreak)374 End Sub375 '转到书签376 Public Sub GotoBookMark(ByVal strBookMark As String)377 Dim missing = System.Reflection.Missing.Value378 Dim BookMark = CInt(Word.WdGoToItem.wdGoToBookmark)379 oWordApplic.Selection.GoTo(BookMark, missing, missing, strBookMark)380 End Sub381 '判断书签是否存在382 Public Function BookMarkExist(ByVal strBookMark As String) As Boolean383 Dim Exist As Boolean384 Exist = oDocument.Bookmarks.Exists(strBookMark)385 Return Exist386 End Function387 '替换书签的内容388 Public Sub ReplaceBookMark(ByVal icurnum As String, ByVal strcontent As String) 389 strcontent = strcontent.Replace("0:00:00", "")390 oDocument.Bookmarks(icurnum).Select()391 oWordApplic.Selection.TypeText(strcontent)392 End Sub393394 '得到书签的名称395 Public Function GetBookMark(ByVal icurnum As String, ByRef bo As Boolean) As String 396 Dim strReturn As String397 If Right(oDocument.Bookmarks(icurnum).Name, 5) = "TABLE" Then398 bo = True399 Dim strTemp As String400 strTemp = oDocument.Bookmarks(icurnum).Name()401 strReturn = Mid(strTemp, 1, Len(strTemp) - 5)402 Else403 bo = False404 strReturn = oDocument.Bookmarks(icurnum).Name405 End If406 Return strReturn407 End Function408 '得到书签的名称409 Public Function GetBookMark1(ByVal icurnum As String) As String410 Return oDocument.Bookmarks(icurnum).Name411 End Function412 '转到文档结尾413 Public Sub GotoTheEnd()414 Dim missing = System.Reflection.Missing.Value415 Dim unit = Word.WdUnits.wdStory416 oWordApplic.Selection.EndKey(unit, missing)417 End Sub418 '转到文档开头419 Public Sub GotoTheBegining()420 Dim missing = System.Reflection.Missing.Value421 Dim unit = Word.WdUnits.wdStory422 oWordApplic.Selection.HomeKey(unit, missing)423 End Sub424 '删除多余的一行425 Public Sub DelUnuseRow()426 oWordApplic.Selection.Rows.Delete()427 End Sub428 '转到表格429 Public Sub GotoTheTable(ByVal ntable As Integer)430 'Dim missing = System.Reflection.Missing.Value431 'Dim what = Word.WdGoToItem.wdGoToTable432 'Dim which = Word.WdGoToDirection.wdGoToFirst433 'Dim count = ntable434435 'oWordApplic.Selection.GoTo(what, which, count, missing)436 'oWordApplic.Selection.ClearFormatting()437438 'oWordApplic.Selection.Text = ""439 oRange = oDocument.Tables(ntable).Cell(1, 1).Range440 oRange.Select()441442 End Sub443 '转到表格的某个单元格444 Public Sub GotoTableCell(ByVal ntable As Integer, ByVal nRow As Integer, ByVal nColumn As Integer)445 oRange = oDocument.Tables(ntable).Cell(nRow, nColumn).Range446 oRange.Select()447 End Sub448 '表格中转到右面的单元格449 Public Sub GotoRightCell()450 Dim missing = System.Reflection.Missing.Value451 Dim direction = Word.WdUnits.wdCell452 oWordApplic.Selection.MoveRight(direction, missing, missing)453 End Sub454 '表格中转到左面的单元格455 Public Sub GotoLeftCell()456 Dim missing = System.Reflection.Missing.Value457 Dim direction = Word.WdUnits.wdCell458 oWordApplic.Selection.MoveLeft(direction, missing, missing)459 End Sub460 '表格中转到下面的单元格461 Public Sub GotoDownCell()462 Dim missing = System.Reflection.Missing.Value463 Dim direction = Word.WdUnits.wdCell464 oWordApplic.Selection.MoveDown(direction, missing, missing)465 End Sub466 '表格中转到上面的单元格467 Public Sub GotoUpCell()468 Dim missing = System.Reflection.Missing.Value469 Dim direction = Word.WdUnits.wdCell470 oWordApplic.Selection.MoveUp(direction, missing, missing)471 End Sub472 '文档中所有的书签总数473 Public Function TotalBkM() As Integer474 Return oDocument.Bookmarks.Count475 End Function476 '选中书签477 Public Sub SelectBkMk(ByVal strName As String)478 oDocument.Bookmarks.Item(strName).Select()479 End Sub480 '插入图片481 Public Sub InsertPic(ByVal FileName As String)482 Dim missing = System.Reflection.Missing.Value483 oWordApplic.Selection.InlineShapes.AddPicture(FileName, False, True, missing).Select()484 oShape = oWordApplic.Selection.InlineShapes(1).ConvertToShape485 oWordApplic.Selection.WholeStory()486 oShape.ZOrder(Microsoft.Office.Core.MsoZOrderCmd.msoSendBehindText)487 End Sub488 '统一调整图片的位置.也就是往上面调整图片一半的高度489 Public Sub SetCurPicHei()490 Dim e As Word.Shape491 For Each e In oDocument.Shapes492 oDocument.Shapes().Select()493 oWordApplic.Selection.ShapeRange.RelativeHorizontalPosition = Word.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionPage494 oWordApplic.Selection.ShapeRange.RelativeVerticalPosition = Word.WdRelativeVerticalPosition.wdRelativeVerticalPositionParagraph495 oWordApplic.Selection.ShapeRange.LockAnchor = True496'oWordApplic.Selection.ShapeRange.IncrementTop(oDocument.Shapes().Height)497 Next498 End Sub499500 Public Sub SetCurPicHei1()501 Dim e As Word.Shape502 For Each e In oDocument.Shapes503 oDocument.Shapes().Select()504oWordApplic.Selection.ShapeRange.IncrementTop(oDocument.Shapes().Height / 2)505 Next506 End Sub507 Public Sub SetCurPicHei2()508 Dim e As Word.Shape509 For Each e In oDocument.Shapes510 oDocument.Shapes().Select()511oWordApplic.Selection.ShapeRange.IncrementTop(-oDocument.Shapes().Height / 2)512 Next513 End Sub514 Public Function intToUpint(ByVal a As Integer) As String515 Dim result As String = "一百"516 Dim a1, a2 As Integer517 Dim strs() As String = {"零", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十"} 518 If (a <= 10) Then519 result = strs(a)520 ElseIf (a < 100) Then521 a1 = a / 10522 a2 = a Mod 10523 If (a = 1) Then524 result = "十" + strs(a2)525 End If526 Else527 result = strs(a1) + "十" + strs(a2)528 End If529 Return result530 End Function531 '合并没有参照的某一列,一般来讲对应第一列532 'itotalrow 总行数533 'initrow 初始开始的行数,一般情况下该值不为0,没有标题栏的一般为0534 'intcol 列数535 Public Sub MergeSingle(ByVal itotalrow As Integer, ByVal initrow As Integer, ByVal intcol As Integer)536 oDocument.Tables(1).Cell(initrow + 1, intcol).Select()537 Dim irow As Integer '当前行数538 Dim strValue As String '循环比较的行初值539 Dim i As Integer540 Dim direction = Word.WdUnits.wdLine541 Dim extend = Word.WdMovementType.wdExtend542543 i = 0544 irow = 1 + initrow '初始值为1545 For i = 2 + initrow To itotalrow + initrow546547 strValue = oDocument.Tables(1).Cell(irow, intcol).Range.Text548 If (oDocument.Tables(1).Cell(i, intcol).Range.Text = oDocument.Tables(1).Cell(irow, intcol).Range.Text) Then549 '这是对最后一次处理的特殊情况.550 If (i = itotalrow + initrow) Then551 oWordApplic.Selection.MoveDown(direction, (i - irow), extend)552 If (i - irow >= 1) Then553 oWordApplic.Selection.Cells.Merge()554 End If555 oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue556 End If557 Else558 oWordApplic.Selection.MoveDown(direction, (i - irow - 1), extend)559 If (i - irow - 1 >= 1) Then560 oWordApplic.Selection.Cells.Merge()561 End If562 oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue563 irow = i564 oDocument.Tables(1).Cell(irow, intcol).Select()565 End If566 Next i567 End Sub568 '合并有参照的某一列569 'itotalrow 总行数570 'initrow 初始开始的行数,一般情况下该值不为0,没有标题栏的一般为0571 'intcol 列数572 'basecol 参照合并的那一列573 Public Sub MergeDouble(ByVal itotalrow As Integer, ByVal initrow As Integer, ByVal intcol As Integer, ByVal basecol As Integer)574 oDocument.Tables(1).Cell(initrow + 1, intcol).Select()575 Dim irow As Integer '当前行数576 Dim strValue As String '循环比较的行初值577 Dim i As Integer578 Dim direction = Word.WdUnits.wdLine579 Dim extend = Word.WdMovementType.wdExtend580581 i = 0582 irow = 1 + initrow '初始值为1583 For i = 2 + initrow To itotalrow + initrow584585 strValue = oDocument.Tables(1).Cell(irow, intcol).Range.Text586 If (oDocument.Tables(1).Cell(i, intcol).Range.Text = oDocument.Tables(1).Cell(irow, intcol).Range.Text) And (getdata(i, basecol) = getdata(irow, basecol)) Then587 '这是对最后一次处理的特殊情况.588 If (i = itotalrow + initrow) Then589 oWordApplic.Selection.MoveDown(direction, (i - irow), extend)590 If (i - irow >= 1) Then591 oWordApplic.Selection.Cells.Merge()592 End If593 oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue594 End If595 Else596 oWordApplic.Selection.MoveDown(direction, (i - irow - 1), extend)597 If (i - irow - 1 >= 1) Then598 oWordApplic.Selection.Cells.Merge()599 End If600 oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue601 irow = i602 oDocument.Tables(1).Cell(irow, intcol).Select()603 End If604 Next i605 End Sub606 '得到某个单元的值,如果为空的话,有两种情况.607 '其一：是一个合并的单元格，取其上面的值608 '其二：该单元格本来就是空值609 Public Function getdata(ByVal introw As Integer, ByVal intcol As Integer) As String610 Try611 If (oDocument.Tables(1).Cell(introw, intcol).Range.Text = "" Or (oDocument.Tables(1).Cell(introw, intcol).Range.Text = Nothing)) Then612 getdata = getdata(introw - 1, intcol)613 Else614 getdata = oDocument.Tables(1).Cell(introw, intcol).Range.Text615 End If616 Catch ex As Exception617 getdata = getdata(introw - 1, intcol)618 End Try619620621 End Function622End Class要想作为一个优秀的编程人员，不得不每天都进行学习，来增加自己的知识库，以免被技术所淘汰。

vb操作word详解

vb操作(cāozuò)word详解vb操作(cāozuò)word详解vb操作(cāozuò)word详解Visual Basic支持一个对象集合，该集合中的对象直接对应于Microsoft Word 97中的元素，并且通过用户界面，用户熟悉这些元素中的绝大多数。

例如，Document 对象代表了一个打开的文档，Bookmark对象代表了一个文档中的书签，而Selection对象则代表了在一个文档窗口窗格(chuānɡ ɡé)中的选定内容。

在Word中，每一类元素－文档、表格、段落、书签、域等等－都可以用Visual Basic的对象来表示。

要在Word中自动执行任务，可以使用这些对象的方法和属性。

关于理解和使用Microsoft Office 97对象模型的一般性内容，请参阅本书的第二章“理解对象模型”。

在Microsoft Office 97中的对象模型相当丰富(fēngfù)，其中包含了大约180个对象。

要查看Word对象模型的层次关系图，请参阅“帮助”中的“Microsoft Word 对象”。

要获得对某种特定对象的详细描述，可以在此图中单击该对象的名字，或是在“帮助”的索引中对特定对象进行搜索。

怎样(zěnyàng)显示Word Visual Basic帮助要使用Word Visual Basic帮助，必须在安装过程中选择“自定义”的安装方式，并且为Word选中“Visual Basic在线(zàixiàn)帮助”复选框。

否则，安装程序不会安装Visual Basic帮助。

如果用户已经安装好了Word，那么可以再次运行Setup程序来安装Visual Basic帮助。

要查看Word Visual Basic 帮助，可以在“Visual Basic 编辑器里的“帮助”菜单中点击“目录和索引(suǒyǐn)”一项。

vb操作word全

End WithEnd WithnewDoc.SaveAs filePathnewDoc.CloseEnd Function2、VB程序操作word表格（文字、图片）很多人都知道，用vb操作excel的表格非常简单，但是偏偏项目中碰到了VB操作word表格的部分，google、baidu搜爆了，都没有找到我需要的东西。

到是搜索到了很多问这个问题的记录。

没办法，索性只有自己去尝试了。

下面把一些代码发上来，给需要的朋友一点提示。

打开一个已经存在的wrod文件（这个文件包含了表格）Dim WordAppDim WordSet WordApp = CreateObject("Word.Application")WordApp.Visible = TrueSet Word = WordApp.Documents.Open("c:\record.dot")知道了就很简单了，下面是选定某一个表格的一个单元格，并修改其内容Word.Tables(1).cell(1, 2)="内容"VBA中的这些数组元素下标都是从1开始的，比如excel的第一行一列也是ExSheet.Cells(1,1),而不是ExSheet.Cells（0,0）,WORD的表格也是这样，不信自己试一下就知道了。

所以上面那句话的意思就是对整个word 文档中的第一个表格的第一行第二列的内容改变为“内容”。

很简单吧？网上有些人在问是不是Word.Tables(1).cell(1, 2).range.text或者Word.Tables(1).cell(1, 2).text。

试一下就发现这2种都不对。

用VBA实现Office操作题的自动阅卷-文档资料

用VBA实现Office操作题的自动阅卷在目前的办公自动化软件屮,Microsoft Office 的应用已极为普遍,因此在高中信息技术会考中，Word、Excel已经成为必考内容。

如果它们的操作题单纯依靠人工阅卷，效率会非常低，而且容易出现误判、漏判、给分不公正等问题。

目前，信息技术会考软件己经实现了Office操作题的自动阅卷功能，但任课教师如果想要在平时的教学中使用这些软件，就必须花钱购买。

为了解决这个问题，我认真研究了很多资料，使用Office软件自带的VBA宏指令编程，实现了操作题的自动阅卷功能。

1VBA的基本概念与实现原理VBA 是指Visual Basic for Application, 它是在Office中使用的宏语言，主要为了增强Word. Excel等软件的自动化能力。

VBA 的语法类似VB,但提供了很多VB中没有的函数和对象，这些函数、对象都是针对Office应用的。

因此可以像编写VB程序那样来编写VBA程序，以实现某个功能。

2VBA针对Word的主要对象VBA中带有大量专门针对Office（包括Word Excel、PowerPoint以及Access）文件的对象，限于篇幅问题,本文只介绍针对Word的VBA对象。

在Word中我们能够获得的最高层对象是Application对象，它代表的是Word应用程序本身。

在Application 对象中包含了—些其他的对象集合，例如：Document、windows> Selection等对象。

documents对象集合和document对象都是Application对象的子对象。

documents对象集合是所有的document对象的集合,document对象代表的是一篇完整的Word文档,它包括了文档中所有的对象如段落、文本、字、句、表格格式等。

如果VBA代码与考试题在同一个文档中，建议大家使用ThisDocument对象，它代表当前文档，这样能够省去打开文档、保存文档、关闭文档等复杂操作。