In VB6.0, operate Word, use it powerful lookup, replace, delete, copy, and documerate. You can also replace a specific character with a picture. With it you can replace specific characters in the Word file using content or image file in the database.
Just copy the following content to the writepad, save it as a setword.cls file, and then add it to the project, you can use it.
VERSION 1.0 CLASSBEGIN MultiUse = -1 'True Persistable = 0' NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0' vbNone MTSTransactionMode = 0 'NotAnMTSObjectENDAttribute VB_Name = "SetWord" Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = TrueAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = FalsePrivate mywdapp As Word .Applicationprivate mysel as Object
'Module Variable Variable of Attribute Value Private C_Templatedoc As StringPrivate C_Newdoc As StringPrivate C_PICFILE AS STRINGPRIVATE C_ERRMSG AS INTEGER
Public Event HaveError () Attribute HaveError.vb_description = "This event is stimulated when the error code is ERRMSG attribute" '************************ ********************************************* 'Errmsg code: 1-Word is not installed 2 - missing parameters 3 - No right to write files' 4 - file does not exist '' ***************************************************************** ***********************************
Public Function ReplacePic (FINDSTR AS STRING, OPTIONAL TIME AS INTEGER = 0) AS Integerattribute = "Find FINDSTR, and replaced with the picture file pointed to by Picfile, the number of replacements is determined by the TIME parameter, 0, replace all"
'********************************************************** ************************* From Word.Range Object MySEL, and replaced with Picfile Image ' The number of times is determined by the TIME parameter, when it is 0, replace all '******************************************** *************************************************
If Len (C_PICFILE) = 0 THEN C_ERRMSG = 2 EXIT functionEND IF
DIM I as bugdim 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 = iEnd FunctionPublic Function FindThis (FINDSTR AS STRING) AS BooleanAttribute Findthis.vb_description = "Find FindStr, Returns true" if Len (Findstr) = 0 THEN C_ERRMSG = 2 EXIT FUNCTIONEND 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.executeEnd Function
Public Function ReplaceChar (FindStr As String, RepStr As String, Optional Time As Integer = 0) As IntegerAttribute ReplaceChar.VB_Description = "Find findstr, and replaced RepStr, the replacement time is determined by the number of parameters to 0, replacing all '' * *********************************************************** *************************** The number of FINDSTRs from Word.Rrough Object MySEL is replaced with the REPSTR 'Replacement number by TIME parameters OK, when 0, replace all '********************************************************** *********************************************** DIM FINDTXT As Booleanif LEN (FINDSTR) = 0 THEN C_errmsg = 2 raiseEvent HaveError EXIT FUNCTIONEND 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 Findt = mysel.find.execute (replace: = wdreplaceone) if not findtxt the exit for next if i = 1 and not findtxt the replacechar = 0 else Replacechar = i end if else mysel.find.execute replace: = WDREPLACEALL END IFEND FUNCTION
Public Function GetPic (Picdata () as Byte, FileName AS String) AS BooleanAttribute getPic.vb_description = "The file data PicData, the file specified by Picfile" '*************** *********************************************************** ************** The image data Picdata, the file specified as a Picfile '******************************************** *********************************************************** ******* On Error ResMe nextif Len (filename) = 0 THEN C_ERRMSG = 2 raiseEvent HaveError EXIT FUNCTIONEND IF
Open filename for binary as # 1
IF err.number <> 0 THEN c_ERRMSG = 3 exit functionendiff
'Binary files with GET, PUT, read data PUT # 1, PicDataClose # 1
C_PICFILE = filenamegetpic = TRUE
END FUNCTION
Public Sub deleteToeend () attribute deletetoeend.vb_description = "Delete all content from the current location" Mysel.endKey Unit: = wdstory, extend: = WDEXTENDMYSEL.DELETE Unit: = WDCharacter, count: = 1END SUB
Public Sub Movend () Attribute Movend.vb_description = "Cursor Move to Document End" 'Cursor Move to Document End Mysel.endKey Unit: = WDSTORYEND 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 = "Opens Word file, View Determines if the Word interface is displayed" On Error ResMe Next
'********************************************************** ************************* Open the Word file and give the global variable mysel assignment '******* *********************************************************** **********************
IF LEN (C_Templatedoc) = 0 Then Mywdapp.documents.addelse MywDapp.Documents.Open (c_templatedoc) endiff
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 SubPublic Sub OpenWord () On Error Resume Next
'********************************************************** ************************** Open the Word program and give the global variable mywdapp assign a value '******* *********************************************************** **********************
Set mywdapp = creteObject ("word.application") if err.number <> 0 THEN c_ERRMSG = 1 raiseeevent HaveError EXIT SUB End IFEND SUB
Public Sub ViewDoc.vb_description = "Display Word Program Interface" MywDapp.visible = TrueEnd Sub
Public Sub AddNewpage () attribute addnewpage.vb_description = "Insert Page Reform" MySEL.INSERTBREAK TYPE: = WDPAGEBREAKEND SUB
Public Sub WordCut () Attribute WordCut.vb_description = "Cut Template All Content to Cutting Board" 'Save Template Page Content Mysel.WholeStory Mysel.cut mysel.homekey unit: = WDSTORYEND SUB
Public Sub WordCopy () Attribute WordCopy.vb_description = "Copy Template All Contents to Cut Board" Mysel.WholeStory mysel.copy mysel.homekey unit: = wdstoryend Sub
Public Sub WordDel () mysel.wholestory mysel.delete mysel.homekey unit: = WDSTORYEND SUB
Public Sub WordPaste () Attribute WordPaste.vb_description = "Copy Shearing Board Content to Current Position" 'Insert Module Content Mysel.Pasteend Sub
PUBLIC SUB CloseDoc.vb_description = "Close Word File Template" '******************************************* ************************************ * Close Word File model '************************************************************* ****************************************** ON ERROR Resume NextMywdapp.activeDocument.close False
If Err.Number <> 0 THEN C_ERRMSG = 3 EXIT SUBEND IF
End Sub
Public SUB QuitWord () '************************************************************************************************************************************************************** ********************************** The Word program '********** *********************************************************** ******************** ON Error Resume Next
Mywdapp.quit if err.number <> 0 THEN C_ERRMSG = 3 EXIT SUBEND IFEND SUB
Public Sub SaveTodoc () Attribute Savetodoc.vb_description = "Save the current document for filename Specify file" On Error ResMe Next
'And save as file filename
If Len (C_Newdoc) = 0 THEN C_ERRMSG = 2 RaiseEvent HaveError EXIT SUBEND 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.vb_description = "Template file name." TemplatedOc = C_TemPlatedOcend Property
Public Property Let Templatedoc (Byval VNewValue As String) C_Templatedoc = VNewValueEnd Property
Public property get newdoc.vb_description = "When performing a closedoc method, save the template file as a new file specified by this file name. If not specified, an error will be generated when executing the Closedoc method," newDoc = C_NewDocend Property
Public property letn newdoc (byval vnewvalue as string) c_newdoc = vnewvalueend property
Public property get picfile.vb_description = "Image file name" picfile = c_picfilend propertypublic Property Let Picfile (Byval VNewValue As String) c_picfile = vnewvalueend property
Public property get errmsg () as integerattribute = "Error information .ERRMSG code: 1-Word no installation 2 - missing parameter 3 - No rights limit file 4- file does not exist" errmsg = c_ERRMSGEND PROPERTY
