在Word中從Access數(shù)據(jù)庫隨機(jī)抽取試題制作試卷的方法

----------------------------精品word文檔值得下載值得擁有--------------------------------------------------------------------------精品word文檔值得下載值得擁有---------------------------------------------------------------------------------------------------------------------------------------------------------------------------在Word中從Access數(shù)據(jù)庫隨機(jī)抽取試題制作試卷的方法在Word中，從Access數(shù)據(jù)庫的對(duì)應(yīng)表中，隨機(jī)抽取試題并制作成一定版面的試卷，我作了一些嘗試，試卷要求：生成大題及對(duì)應(yīng)的分值，題目隨機(jī)抽取，單選、多選答案也要隨機(jī)變化（其中含有“以上”字樣開頭的，必須是第三個(gè)或者第四個(gè)答案），并根據(jù)抽取的題目情況，生成對(duì)應(yīng)的參考答案文件（文件是文本文件）。一、數(shù)據(jù)庫其中blankQt、judgeQt、multiQt、singleQt結(jié)構(gòu)如上，分別裝的是填空題、判斷題、多選題、單選題內(nèi)容。數(shù)據(jù)可以自己根據(jù)需要填寫。二、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'設(shè)置標(biāo)題（一二級(jí)）DimsRsAsADODB.Recordset'對(duì)單選題進(jìn)行處理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="一、單項(xiàng)選擇題（每小題3分，有"&iST&"個(gè)小題，共"&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'對(duì)多選題進(jìn)行處理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="二、多項(xiàng)選擇題（每小題4分，有"&iMT&"個(gè)小題，共"&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'對(duì)判斷題進(jìn)行處理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&"個(gè)小題，共"&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'對(duì)填空題進(jìn)行處理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&"個(gè)小題，共"&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'為整篇文檔設(shè)置Tab位置EndSubPrivateSubsetDocTitle(ByValbTAsString,ByValsTAsString)'設(shè)置文檔標(biāo)題與小標(biāo)題，分別為一級(jí)標(biāo)題和二級(jí)標(biāo)題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'清除此文檔的所有內(nèi)容'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>"'以下是單項(xiàng)選擇題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'以下多項(xiàng)選擇題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.窗體對(duì)應(yīng)代碼ConstGkSNumsAsInteger=41ConstGkMNumsAsInteger=9ConstGkJNumsAsInteger=26ConstGkBNumsAsInteger=17PrivateSubcmdClrDoc_Click()clearThisDocTrueEndSubPrivateSubcmdOutToXML_Click()'生成對(duì)應(yīng)的四個(gè)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