在Word中从Access数据库随机抽取试题制作试卷的方法

----------------------------精品word文档值得下载值得拥有--------------------------------------------------------------------------精品word文档值得下载值得拥有---------------------------------------------------------------------------------------------------------------------------------------------------------------------------在Word中从Access数据库随机抽取试题制作试卷的方法在Word中，从Access数据库的对应表中，随机抽取试题并制作成一定版面的试卷，我作了一些尝试，试卷要求：生成大题及对应的分值，题目随机抽取，单选、多选答案也要随机变化（其中含有“以上”字样开头的，必须是第三个或者第四个答案），并根据抽取的题目情况，生成对应的参考答案文件（文件是文本文件）。一、数据库其中blankQt、judgeQt、multiQt、singleQt结构如上，分别装的是填空题、判断题、多选题、单选题内容。数据可以自己根据需要填写。二、VBA窗体利用Word自身所带的VBA，制作窗体如下：三、VBA代码1.模块中代码SubstartMacro()optForm.ShowEndSubSubreadTable(ByValsBTAsString,ByValsSTAsString,ByValiSTAsInteger,ByValiMTAsInteger,ByValiJTAsInteger,ByValiBTAsInteger)Dimtm(3000)AsString,bx(3000,4)AsString,da(3000)AsString,iAsInteger,jAsInteger,cnSqAsString,tmCntAsIntegerDimsubNo()AsInteger,xHs()AsIntegerDimtmpTmAsString,tmpBxAsString,tmpDaAsString,tABCDAsString,tmpZMAsString,outDaAsString,qtTitleAsString,da1AsStringDimconnAsADODB.ConnectionSetconn=NewADODB.ConnectionDimcnSrAsStringcnSr="driver={microsoftaccessdriver(*.mdb,*.accdb)};dbq="&ThisDocument.Path&"\nopapertest.mdb"conn.OpencnSrDimrefDaFileAsStringrefDaFile=ThisDocument.Path&"\"&sST&"(参考答案).txt"OpenrefDaFileForOutputAs#1Print#1,sBTPrint#1,sST&"(参考答案)"&vbCrLfsetDocTitlesBT,sST'设置标题（一二级）DimsRsAsADODB.Recordset'对单选题进行处理SetsRs=NewADODB.RecordsetcnSq="select题目,备选A,备选B,备选C,备选D,答案fromsingleQt"sRs.OpencnSq,conni=0DoWhileNotsRs.EOFi=i+1tm(i)=sRs(0)Forj=1To4bx(i,j)=sRs(j)Nextda(i)=bx(i,sRs(5)*1)sRs.MoveNextLooptmCnt=iReDimsubNo(iST),xHs(4)DimySBx(4)AsStringrandArraysubNo,iST,tmCntqtTitle="一、单项选择题（每小题3分，有"&iST&"个小题，共"&3*iST&"分)"Selection.TypeTextqtTitle&vbCrLfPrint#1,qtTitlePrint#1,"1-5:";Fori=1ToiST'Selection.TypeTextxHs(1)&xHs(2)&xHs(3)&xHs(4)&vbCrLftmpTm=tm(subNo(i))tmpDa=da(subNo(i))Selection.TypeTexti&"、"&tmpTm&vbCrLfySBx(1)=bx(subNo(i),1)ySBx(2)=bx(subNo(i),2)ySBx(3)=bx(subNo(i),3)ySBx(4)=bx(subNo(i),4)IfInStr(ySBx(4),"以上")>0AndInStr(ySBx(3),"以上")>0ThenrandArrayxHs,2,2xHs(3)=3:xHs(4)=4ElseIfInStr(ySBx(4),"以上")>0ThenrandArrayxHs,3,3xHs(4)=4ElserandArrayxHs,4,4EndIfForj=1To4tmpBx=ySBx(xHs(j))Ifj=1Thenda1=tmpBxtABCD=Chr(64+j)SelectCaseLen(da1)CaseIs<=8IfjMod4<>0ThenoutDa=tmpBx&vbTabElseoutDa=tmpBx&vbCrLfEndIfCaseIs<=16IfjMod2<>0ThenoutDa=tmpBx&vbTabElseoutDa=tmpBx&vbCrLfEndIfCaseElseoutDa=tmpBx&vbCrLfEndSelectSelection.TypeTexttABCD&"."&outDaIftmpBx=tmpDaThentmpZM=tABCDNextPrint#1,tmpZM;Ifi=iSTOriMod20=0ThenIfi=iSTThenPrint#1,""'Print#1,(i\5)*5+1&"-"&iST&":";ElsePrint#1,""Print#1,(i\5)*5+1&"-"&((i\5)+1)*5&":";EndIfElseIfiMod5=0Andi<iST-5ThenPrint#1,vbTab&(i\5)*5+1&"-"&((i\5)+1)*5&":";EndIfEndIfNextsRs.CloseSetsRs=NothingDimmRsAsADODB.Recordset'对多选题进行处理SetmRs=NewADODB.RecordsetcnSq="select题目,备选A,备选B,备选C,备选D,答案frommultiQt"mRs.OpencnSq,conni=0DoWhileNotmRs.EOFi=i+1tm(i)=mRs(0)da(i)=""Forj=1To4bx(i,j)=mRs(j)IfMid(mRs(5),j,1)="1"Thenda(i)=da(i)&"[["&bx(i,j)&"]]"EndIfNextmRs.MoveNextLooptmCnt=iReDimsubNo(iMT),xHs(4)randArraysubNo,iMT,tmCntqtTitle="二、多项选择题（每小题4分，有"&iMT&"个小题，共"&4*iMT&"分)"Selection.TypeTextqtTitle&vbCrLfPrint#1,vbCrLf&qtTitleFori=1ToiMTrandArrayxHs,4,4'Selection.TypeTextxHs(1)&xHs(2)&xHs(3)&xHs(4)&vbCrLftmpTm=tm(subNo(i))tmpDa=da(subNo(i))Selection.TypeTexti&"、"&tmpTm&vbCrLftmpZM=""Forj=1To4tmpBx=bx(subNo(i),xHs(j))Ifj=1Thenda1=tmpBxtABCD=Chr(64+j)IfInStr(tmpDa,"[["&tmpBx&"]]")>0ThentmpZM=tmpZM&tABCDEndIfSelectCaseLen(da1)CaseIs<=8IfjMod4<>0ThenoutDa=tmpBx&vbTabElseoutDa=tmpBx&vbCrLfEndIfCaseIs<=16IfjMod2<>0ThenoutDa=tmpBx&vbTabElseoutDa=tmpBx&vbCrLfEndIfCaseElseoutDa=tmpBx&vbCrLfEndSelectSelection.TypeTexttABCD&"."&outDaNext'Selection.TypeTexttmpZM&":"&tmpDa&vbCrLfPrint#1,i&"."&tmpZM&vbTab;Ifi=iMTOriMod10=0ThenPrint#1,""NextmRs.CloseSetmRs=NothingDimjRsAsADODB.Recordset'对判断题进行处理SetjRs=NewADODB.RecordsetcnSq="select题目,答案fromjudgeQt"jRs.OpencnSq,conni=0DoWhileNotjRs.EOFi=i+1tm(i)=jRs(0)da(i)=jRs(1)jRs.MoveNextLooptmCnt=iReDimsubNo(iJT)DimkAsIntegerrandArraysubNo,iJT,tmCntqtTitle="三、判断题（每小题2分，有"&iJT&"个小题，共"&2*iJT&"分)"Selection.TypeTextqtTitle&vbCrLfPrint#1,vbCrLf&qtTitlePrint#1,"1-5:";Fori=1ToiJTtmpTm=tm(subNo(i))tmpDa=da(subNo(i))Selection.TypeTexti&"、"&tmpTm&vbCrLftmpZM=""IfUCase(tmpDa)="TRUE"OrUCase(tmpDa)="ON"OrUCase(tmpDa)="YES"OrtmpDa="1"ThentmpZM="A"ElsetmpZM="B"EndIfPrint#1,tmpZM;Ifi=iJTOriMod20=0ThenIfi=iJTThenPrint#1,""'Print#1,(i\5)*5+1&"-"&iJT&":";ElsePrint#1,""Print#1,(i\5)*5+1&"-"&((i\5)+1)*5&":";EndIfElseIfiMod5=0ThenPrint#1,vbTab&(i\5)*5+1&"-"&((i\5)+1)*5&":";EndIfEndIfNextjRs.CloseSetjRs=NothingDimbRsAsADODB.Recordset'对填空题进行处理cnSq="select题目,答案fromblankQt"SetbRs=NewADODB.RecordsetbRs.OpencnSq,conni=0DoWhileNotbRs.EOFi=i+1tm(i)=bRs(0)da(i)=bRs(1)bRs.MoveNextLooptmCnt=iReDimsubNo(iBT)randArraysubNo,iBT,tmCntqtTitle="四、填空题（每小题3分，有"&iBT&"个小题，共"&3*iBT&"分)"Selection.TypeTextqtTitle&vbCrLfPrint#1,vbCrLf&vbCrLf&qtTitleFori=1ToiBTtmpTm=tm(subNo(i))tmpDa=da(subNo(i))Selection.TypeTexti&"、"&tmpTm&vbCrLfPrint#1,i&"、"&tmpDaNextbRs.CloseSetbRs=Nothingconn.CloseSetconn=NothingClose#1setTabPosition'为整篇文档设置Tab位置EndSubPrivateSubsetDocTitle(ByValbTAsString,ByValsTAsString)'设置文档标题与小标题，分别为一级标题和二级标题ActiveWindow.ActivePane.View.Type=wdOutlineViewSelection.Range.Paragraphs.Style=ActiveDocument.Styles(wdStyleHeading1)Selection.TypeTextText:=bTSelection.HomeKeyUnit:=wdLine,Extend:=wdExtendSelection.ParagraphFormat.Alignment=wdAlignParagraphCenterSelection.EndKeyUnit:=wdLineSelection.TypeParagraphSelection.Range.Paragraphs.Style=ActiveDocument.Styles(wdStyleHeading2)Selection.TypeTextText:=sTSelection.HomeKeyUnit:=wdLine,Extend:=wdExtendSelection.ParagraphFormat.Alignment=wdAlignParagraphCenterSelection.EndKeyUnit:=wdLineSelection.TypeParagraphSelection.Range.Style=ActiveDocument.Styles(wdStyleNormal)IfActiveWindow.View.SplitSpecial=wdPaneNoneThenActiveWindow.ActivePane.View.Type=wdPrintViewElseActiveWindow.View.Type=wdPrintViewEndIfEndSubPublicSubclearThisDoc(ByValbAsBoolean)''clearThisDocMacro'清除此文档的所有内容'Selection.WholeStorySelection.DeleteUnit:=wdCharacter,Count:=1EndSubPublicSubwriteToEachXML(ByValbAsBoolean)DimconnStrAsString,connAsADODB.ConnectionconnStr="driver={microsoftaccessdriver(*.mdb,*.accdb)};dbq="&ThisDocument.Path&"\nopapertest.mdb"Setconn=NewADODB.Connectionconn.OpenconnStrDimxmlFirstAsStringxmlFirst="<?xmlversion="&Chr(34)&"1.0"&Chr(34)&"encoding="&Chr(34)&"utf-8"&Chr(34)&"?>"DimxmlSrcBeginAsString,xmlSrcEndAsStringxmlSrcBegin="<resources>"xmlSrcEnd="</resources>"DimxmlArrBegin(5)AsStringDimxmlArrEndAsStringxmlArrEnd="</string-array>"'以下是单项选择题DimxmlFileNameAsStringxmlFileName=ThisDocument.Path&"\S\arrays.xml"OpenxmlFileNameForOutputAs#2Print#2,xmlFirstPrint#2,xmlSrcBeginDimsqlAsStringsql="select题目,备选A,备选B,备选C,备选D,答案fromsingleQt"Dimrs2AsADODB.RecordsetSetrs2=NewADODB.Recordsetrs2.Opensql,connxmlArrBegin(0)="singletms"xmlArrBegin(1)="singlebxas"xmlArrBegin(2)="singlebxbs"xmlArrBegin(3)="singlebxcs"xmlArrBegin(4)="singlebxds"xmlArrBegin(5)="singledas"DimiAsInteger,tmpCAsStringFori=0To5rs2.MoveFirstPrint#2,arraySign(xmlArrBegin(i))WhileNotrs2.EOFtmpC=rs2(i)tmpC=Replace(tmpC,"&","&")tmpC=Replace(tmpC,"<","<")tmpC=Replace(tmpC,"@","＠")tmpC=Replace(tmpC,"?","？")Print#2,"<item>"&tmpC&"</item>";rs2.MoveNextWendPrint#2,xmlArrEndNextrs2.CloseSetrs2=NothingPrint#2,xmlSrcEndClose#2'以下多项选择题xmlFileName=ThisDocument.Path&"\M\arrays.xml"OpenxmlFileNameForOutputAs#2Print#2,xmlFirstPrint#2,xmlSrcBeginsql="select题目,备选A,备选B,备选C,备选D,答案frommultiQt"Setrs2=NewADODB.Recordsetrs2.Opensql,connxmlArrBegin(0)="multitms"xmlArrBegin(1)="multibxas"xmlArrBegin(2)="multibxbs"xmlArrBegin(3)="multibxcs"xmlArrBegin(4)="multibxds"xmlArrBegin(5)="multidas"Fori=0To5rs2.MoveFirstPrint#2,arraySign(xmlArrBegin(i))WhileNotrs2.EOFtmpC=rs2(i)tmpC=Replace(tmpC,"&","&")tmpC=Replace(tmpC,"<","<")tmpC=Replace(tmpC,"@","＠")tmpC=Replace(tmpC,"?","？")Print#2,"<item>"&tmpC&"</item>";rs2.MoveNextWendPrint#2,xmlArrEndNextrs2.CloseSetrs2=NothingPrint#2,xmlSrcEndClose#2'以下判断题xmlFileName=ThisDocument.Path&"\J\arrays.xml"OpenxmlFileNameForOutputAs#2Print#2,xmlFirstPrint#2,xmlSrcBeginsql="select题目,答案fromjudgeQt"Setrs2=NewADODB.Recordsetrs2.Opensql,connxmlArrBegin(0)="judgetms"xmlArrBegin(1)="judgedas"Fori=0To1rs2.MoveFirstPrint#2,arraySign(xmlArrBegin(i))WhileNotrs2.EOFtmpC=rs2(i)Ifi=1ThentmpC=IIf(UCase(tmpC)="TRUE","1","2")EndIftmpC=Replace(tmpC,"&","&")tmpC=Replace(tmpC,"<","<")tmpC=Replace(tmpC,"@","＠")tmpC=Replace(tmpC,"?","？")Print#2,"<item>"&tmpC&"</item>";rs2.MoveNextWendPrint#2,xmlArrEndNextrs2.CloseSetrs2=NothingPrint#2,xmlSrcEndClose#2'以下填空题xmlFileName=ThisDocument.Path&"\B\arrays.xml"OpenxmlFileNameForOutputAs#2Print#2,xmlFirstPrint#2,xmlSrcBeginsql="select题目,答案fromblankQt"Setrs2=NewADODB.Recordsetrs2.Opensql,connxmlArrBegin(0)="blanktms"xmlArrBegin(1)="blankdas"Fori=0To1rs2.MoveFirstPrint#2,arraySign(xmlArrBegin(i))WhileNotrs2.EOFtmpC=rs2(i)tmpC=Replace(tmpC,"&","&")tmpC=Replace(tmpC,"<","<")tmpC=Replace(tmpC,"@","＠")tmpC=Replace(tmpC,"?","？")Print#2,"<item>"&tmpC&"</item>";rs2.MoveNextWendPrint#2,xmlArrEndNextrs2.CloseSetrs2=NothingPrint#2,xmlSrcEndClose#2conn.CloseSetconn=NothingEndSubPrivateFunctionarraySign(ByValarrNameAsString)AsStringarraySign="<string-arrayname="&Chr(34)&arrName&Chr(34)&">"EndFunctionPrivateSubrandArray(ByRefa()AsInteger,ByValxBAsInteger,ByValmaxRndAsInteger)DimtmpAsInteger,flagAsBoolean,iAsInteger,jAsInteger',sAsStringRandomizeTimerFori=1ToxBflag=Truetmp=Int(Rnd*maxRnd+1)Forj=1Toi-1Ifa(j)=tmpThenflag=FalseExitForEndIfNextIfflag=TrueThena(i)=tmp's=s&a(i)&","Elsei=i-1EndIfNext'MsgBoxsEndSubPrivateSubsetTabPosition()Selection.WholeStorySelection.ParagraphFormat.TabStops.ClearAllActiveDocument.DefaultTabStop=CentimetersToPoints(0.74)Selection.ParagraphFormat.TabStops.AddPosition:=CentimetersToPoints(3.52)_,Alignment:=wdAlignTabLeft,Leader:=wdTabLeaderSpacesSelection.ParagraphFormat.TabStops.AddPosition:=CentimetersToPoints(7.04)_,Alignment:=wdAlignTabLeft,Leader:=wdTabLeaderSpacesSelection.ParagraphFormat.TabStops.AddPosition:=CentimetersToPoints(10.56_),Alignment:=wdAlignTabLeft,Leader:=wdTabLeaderSpacesSelection.HomeKeyUnit:=wdStoryEndSub2.窗体对应代码ConstGkSNumsAsInteger=41ConstGkMNumsAsInteger=9ConstGkJNumsAsInteger=26ConstGkBNumsAsInteger=17PrivateSubcmdClrDoc_Click()clearThisDocTrueEndSubPrivateSubcmdOutToXML_Click()'生成对应的四个XML文件writeToEachXMLTrueEndSubPrivateSubUserForm_Initialize()chkGk_ClickEndSubPrivateSubchkGk_Click()IfchkGk.Value=TrueThenMe.frmFreeSet.Enabled=FalseElseMe.frmFreeSet.Enabled=TrueEndIfEndSubPrivateSubchkS_Click()IfchkS.Value=TrueThentxtS.Enabled=TrueElsetxtS.Enabled=FalseEndIfEndSubPrivateSubchkM_Click()IfchkM.Value=TrueThentxtM.Enabled=TrueElsetxtM.Enabled=FalseEndIfEndSubPrivateSubchkJ_Cli