lparameters tcfiletoopen local lcFileToOpen lcFileToOpen = iif(type('tcFileToOpen')='C',tcFileToOpen,'') ********************************************************** ********************************************************** ********************************************************** ** WordMe.dbf is a table on the local drive which has an ODBC connection ** to it. This enables WordMe to be WORD's datasource for the merge document select 0 use c:\thx1138\wordme alias wordme goto top ** load patient data into table Wordme for mailmerge replace pttitle with alltrim(v_patients.ctitle) in wordme replace ptfirst with alltrim(v_patients.cfirstname) in wordme replace ptlast with alltrim(v_patients.clastname) in wordme replace ptadd1 with alltrim(v_patients.caddress1) in wordme replace ptadd2 with alltrim(v_patients.caddress2) in wordme replace ptcsz with alltrim(v_patients.ccity) + ', ' +; alltrim(v_patients.cstate) + ; ' ' + alltrim(v_patients.czip) in wordme ** load dds data into table Wordme for mailmerge replace drtitle with 'Dr.' replace drfirst with alltrim(v_onedentist.cfirstname) in wordme replace drlast with alltrim(v_onedentist.clastname) in wordme replace dradd1 with alltrim(v_onedentist.caddress1) in wordme replace dradd2 with alltrim(v_onedentist.caddress2) in wordme replace drcsz with alltrim(v_onedentist.ccity) + ', ' +; alltrim(v_onedentist.cstate) + ; ' ' + alltrim(v_onedentist.czip) in wordme ** load guarantor data in table Wordme for mailmerge replace gtitle with alltrim(v_moms.ctitle) in wordme replace gfirst with alltrim(v_moms.cfirstname) in wordme replace glast with alltrim(v_moms.clastname) in wordme replace gadd1 with alltrim(v_moms.caddress1) in wordme replace gadd2 with alltrim(v_moms.caddress2) in wordme replace gcsz with alltrim(v_moms.ccity) + ', ' + ; alltrim(v_moms.cstate) + ' ' + ; alltrim(v_moms.czip) in wordme ** select wordme if used("wordme") use in wordme endif ************************************************************* ************************************************************* ************************************************************* ***/ Begin program code /*** * Code to create a new data source to a VFP table. * * Use the Declare DLL function to prototype the * SQLConfigDataSource function. * Using SQLConfigDataSource prevents having to go into * the ODBC Driver Manager and create the DSN. *** * DECLARE Integer SQLConfigDataSource in odbccp32.dll Integer, ; * Integer, String, String ** you must deal with path to wordme.dbf in 3 spots *** * Create a string containing the settings appropriate to the driver. * The following is an example for the Microsoft VFP ODBC driver * accessing the Customer.dbf file. *** * NOTE: Ensure there are no spaces on either side of the equal sign (=). *** Change the path below to point to the Customer table *** *** in the \Samples\Data folder. *** settings="DSN=thx1138 Word DataSource"+chr(0)+; "Description=VFP ODBC Driver"+chr(0)+; "SourceDB=c:\thx1138"+chr(0)+; "SourceType=DBF" ** make a new odbc data source if it is not already present =SQLConfigDataSource(0,1,"Microsoft Visual FoxPro Driver",settings) *!* **************************************************************** *!* ******************** *!* * Create word object *!* ******************** If type("oWordDocument") = "O" ; and type("gHwndWord") = "N" ; and IsWindow(gHwndWord) # 0 && Check if word window is alive oWordDocument=getobject(, "Word.application") && get instance Else oWordDocument=createobject("word.application") && Create word object Endif *!* ******************** *!* * Create word object *!* ******************** cLinkSource ='' With oWordDocument dsname="c:\thx1138\wordme.dbf" wformat=0 wconfirmconv=0 wreadonly=0 wlinktosource=0 waddtofilelist=0 wpassworddoc="" wpasswordtemp="" wrevert=0 wprotectdoc="" wprotecttemp="" wconn="DSN=thx1138 Word DataSource;uid=;pwd=;"+; "sourcedb=c:\thx1138;sourcetype=dbf"+; "exclusive=no;backgroundfetch=yes;collate=machine;" wsqlstatement="SELECT * FROM wordme" .WindowState = 2 && Minimize if empty(lcFileToOpen) .Documents.Add && Add new document. else .Documents.Open(lcFileToOpen) && open an existing document endif .Visible=.T. && Make Word visible. .Activate *********************************************************************** ** SCAN THE DOCUMENT'S DRAWING LAYER FOR SHAPES. SHAPES WITH A ** .LINKFORMAT.SOURCENAME = PHOTO1.JPG - PHOTO10.JPG ARE PHOTO PLACE ** HOLDERS. THE SHAPES DETERMINE THE TOP, ** LEFT, MAX ALLOWABLE HEIGHT AND MAX ALLOWABLE WIDTH OF THE PATIENT'S ** PHOTOS TO BE DISPLAYED. ** SET THE WIDTH AND HEIGHT OF THE PATIENT'S PHOTOS TO PRESERVE ASPECT RATIO ** WITHIN THE SPACE PROVIDED BY SHAPES. ************************************************************************ ** how many shapes are in the DRAWING LAYER of the WORD document store .activedocument.shapes.count to nNumOfShapes if nNumOfShapes <> 0 ** loop thru the Shapes collection for uuu = 1 to nNumOfShapes ** collect the shape's dimensions, position and linked to file cLinkSource = juststem(.activedocument.shapes(uuu).LinkFormat.SourceName) WidthAllowed = .activedocument.shapes(uuu).Width HeightAllowed = .activedocument.shapes(uuu).Height nTop = .activedocument.shapes(uuu).Top nLeft = .activedocument.shapes(uuu).Left ** BitMaps.dbf is a temp cursor created by the calling module. ** The calling module determines the height and width of ** the BITMAP representations of each of the patient's photos. ** BITMAPS has an index on the cImageName called cImage if seek(cLinkSource, 'BitMaps', 'cImage') ** get the height and width of the patient's photo ** measurements are in points (72 points to the logical inch. WORD likes that) HeightFactor = BitMaps.nHeight WidthFactor = BitMaps.nWidth && Center the patient's photo in the shape, preserving the aspect ratio. && Check to see if using the maximum width will make the image too tall. && Set the dimensions based on the result. IF ((WidthAllowed * HeightFactor) / WidthFactor) < HeightAllowed .ActiveDocument.Shapes(uuu).Left = nleft + WidthAllowed/ 8 .ActiveDocument.Shapes(uuu).Width = WidthAllowed .ActiveDocument.Shapes(uuu).Height = ; (.ActiveDocument.Shapes(uuu).Width * HeightFactor) / WidthFactor .ActiveDocument.Shapes(uuu).Top = (HeightAllowed - ; .ActiveDocument.Shapes(uuu).Height) /2 + ntop ELSE .ActiveDocument.Shapes(uuu).Top = ntop + HeightAllowed / 8 .ActiveDocument.Shapes(uuu).Height = HeightAllowed .ActiveDocument.Shapes(uuu).Width = ; (.ActiveDocument.Shapes(uuu).Height * WidthFactor) / HeightFactor .ActiveDocument.Shapes(uuu).Left = ; (WidthAllowed - .ActiveDocument.Shapes(uuu).width) / 2 + ; nleft ENDIF endif seek(cLinkSource, 'BitMaps', 'cImage') endfor uuu = 1 to nNumOfShapes endif nNumOfShapes <> 0 *********************************************************************** ** SCAN THE DOCUMENT'S DRAWING LAYER FOR SHAPES. SHAPES WITH A ** .LINKFORMAT.SOURCENAME = PHOTO1.JPG - PHOTO10.JPG ARE PHOTO PLACE ** HOLDERS. THE SHAPES DETERMINE THE TOP, ** LEFT, MAX ALLOWABLE HEIGHT AND MAX ALLOWABLE WIDTH OF THE PATIENT'S ** PHOTOS TO BE DISPLAYED. ** SET THE WIDTH AND HEIGHT OF THE PATIENT'S PHOTOS TO PRESERVE ASPECT RATIO ** WITHIN THE SPACE PROVIDED BY SHAPES. ************************************************************************ .WindowState = 0 && enlarge window to previous state ENDWITH gHwndWord = GetForegroundWindow() && Save word window handle Do while IsWindow(gHwndWord) # 0 && Wait while Word is alive =inkey(2) Enddo oWordDocument=.Null. && kill the beast and move on with vfpNeil
>PRIVATE delonly, uchoice, inarea, rcount, dtemplate, inrec, sectcnt, maxsect, ; > dsect, drange, rangestart, dtable, dfields, mm > >IF TYPE('diagnum') = 'U' > PUBLIC diagnum > diagnum = 1 >ENDIF >inarea = ALIAS() >IF !EOF() AND !BOF() > inrec = RECNO() >ELSE > inrec = 0 >ENDIF >IF CheckClass('Word.Application') AND TYPE('oRef') = 'O' > =createdir(start_def + 'WORDMERGE') > delonly = .F. > uchoice = 3 > DO FORM whichrep.scx WITH 2 TO uchoice > DOEVENTS > IF uchoice = 3 > oRef.Lead1.Setfocus() > RETURN > ELSE > SET SAFETY OFF > COPY STRUCTURE TO (start_def + 'WORDMERGE\worddata.dbf') > SELECT 0 > USE (start_def + 'WORDMERGE\worddata.dbf') IN 0 EXCLUSIVE > SELECT (inarea) > GO TOP > DO WHILE !EOF() > SCATTER MEMO MEMVAR > IF uchoice = 1 OR (DELETED() AND uchoice = 2) > WAIT WINDOW "Adding Listing # " + ALLT(STR(m.mls_num)) + ; > " To " + start_def + 'WORDMERGE\worddata.dbf' NOWAIT > INSERT INTO worddata FROM MEMVAR > ENDIF > SKIP > ENDDO > SET SAFETY ON > ENDIF > SELECT worddata > RECALL ALL > rcount = RECCOUNT('worddata') > USE > IF rcount > 0 > WAIT WINDOW 'Listings Outputted To ' + start_def + 'WORDMERGE\worddata.dbf' TIMEOUT 3 > SET DEFAULT TO (start_def + 'WORDMERGE') > dtemplate = GETFILE('dot','Templates') > SET DEFAULT TO (start_def) > ON ERROR * > wordapp=GetObject('','Word.Application') > IF !EMPTY(dtemplate) > WAIT WINDOW "Creating Document From " + ALLT(dtemplate) NOWAIT > wordapp.documents.add(dtemplate) > mm=wordapp.activedocument.mailmerge > IF mm.state = 2 > dfields = mm.fields && Get MailMergeFields Object > IF dfields.count > 0 > WAIT WINDOW "Merging Data To New Document" NOWAIT > mm.destination = 0 && Send To New Document > mm.execute && Perform Merge > WAIT WINDOW "MS-Word Merge Completed" TIMEOUT 1 > ELSE > =MESSAGEBOX("NO MERGE FIELDS IN MAIN MERGE DOCUMENT" + CHR(13) + ; > "Please Edit Your Document Template " + CHR(13) + ; > "(" + dtemplate + ")" + CHR(13) + ; > "And Add The Appropriate Fields",48,; > "Check You Document Template") > wordapp.documents.close(0) && Close New Document > WAIT WINDOW "Opening " + dtemplate TIMEOUT 1 > wordapp.documents.open(dtemplate) && Open Template > ENDIF > ELSE > DO CASE > CASE mm.state = 0 > =MESSAGEBOX("New Document Is Not A Main Merge Document",48,; > "Check You Document Template") > CASE mm.state = 1 > =MESSAGEBOX("Main Merge Document Is Missing Data Source",48,; > "Check You Document Template") > ENDCASE > wordapp.visible = .T. > RETURN > ENDIF > maxsect = wordapp.activedocument.sections.count > sectcnt = 0 > SELECT (inarea) > GO TOP > DO WHILE !EOF() > IF uchoice = 1 OR (DELETED() AND uchoice = 2) > sectcnt = sectcnt + 1 > IF sectcnt <= maxsect > WAIT WINDOW "Adding Picture For Listing # " + ALLT(STR(mls_num)) NOWAIT > dsect = wordapp.activedocument.sections(sectcnt) > drange = dsect.range > rangestart = drange.start > drange.insertbefore('<{ARISPICTURE}>') > oRef.Refresh() > oRef.Lead1.Copy(3) > wordapp.selection.find.text = '<{ARISPICTURE}>' > wordapp.selection.find.forward = .T. > wordapp.selection.find.execute > IF !EMPTY(wordapp.selection.find.found) > wordapp.selection.paste() > ENDIF > ENDIF > ENDIF > SKIP > ENDDO > WAIT WINDOW "MS-Word Merge With Picture Completed" TIMEOUT 1 > wordapp.visible = .T. > ELSE > WAIT WINDOW "Select FoxPro Files via ODBC In The Next Dialog" TIMEOUT 2 > wordapp.documents.add() > mm=wordapp.activedocument.mailmerge > mm.maindocumenttype = 0 > wordapp.visible = .T. > mm.opendatasource(start_def + 'WORDMERGE\worddata.dbf') > ENDIF > ON ERROR DO apperror WITH PROGRAM(), MESSAGE(), MESSAGE(1), ; > LINENO(), ERROR(), 0 > ELSE > WAIT WINDOW 'No Listings Outputted' TIMEOUT 3 > ENDIF > IF !EMPTY(inarea) > SELECT (inarea) > IF !EMPTY(inrec) > GO (inrec) > ELSE > GO TOP > ENDIF > oRef.Refresh() > ELSE > SELECT 0 > ENDIF > GO TOP > oRef.Lead1.Setfocus() >ELSE > IF !CheckClass('Word.Application') > WAIT WINDOW 'Sorry...Word Is Not Installed or Functioning Incorrectly' TIMEOUT 3 > ENDIF >ENDIF >WAIT CLEAR >DOEVENTS