/
How to add custom style into MS Word 2007 document

How to add custom style into MS Word 2007 document

Sept 23, 2015

For VFP 8/9

m.loSession=EVALUATE([xfrx("XFRX#INIT")]) 
m.lnRetVal = m.loSession.SetParams("test.docx",,,,,,"NATIVE_FDOCX")
IF m.lnRetVal=0 
   m.loHACK=CREATEOBJECT("_XFRXHACK",m.loSession)
   m.loSession.ProcessReport("_reports\basetext")
   m.loSession.Finalize()
   RELE m.loHACK
END IF 

DEFINE CLASS _XFRXHACK AS CUSTOM
   oEWriter=.NULL.
   cTarget=""
   nVersion=0

   PROCEDURE Init(m.loSession)
      m.loSession=IIF(TYPE("m.loSession.oxfSession")="O",m.loSession.oxfSession,m.loSession)
      This.nVersion=VAL(CHRTRAN(m.loSession.GetVersion();
                       ,CHRTRAN(m.loSession.GetVersion(),"0123456789",""),""))
      This.cTarget=m.loSession.cTarget
      DO CASE
         CASE This.cTarget=="NATIVE_FDOCX" OR This.cTarget=="NATIVE_DOCX"
              =BINDEVENT(m.loSession.oDocumentWriter,"Finalize",This,"Finalize",0)
      ENDCASE
      This.oEWriter=m.loSession.oDocumentWriter
   ENDPROC


   PROCEDURE Finalize(m.tnHeight, m.tnWidth, m.tnPageNo)
      LOCAL m.liSele, m.loEWriter, m.lcPom
      m.liSele=SELECT()
      m.loEWriter=This.oEWriter
      WITH m.loEWriter.oOXML
      * Attention, all text data must be in UTF-8
 
      *m.lcBaseStyle, m.lcBaseName, m.lcHeight (line height in twips), m.lcBefore (before space in twips), m.lcTABSKEY, m.lcTABS, m.llTABs
      .addParagraphStyle("Normal","YourStyle",.ToTWIP(100),"0","","",.F.)

      SELECT (.Alias)

      m.lcPom=;
[ <w:rPr>]+CHR(13)+CHR(10)+;
[ <w:rFonts w:hAnsi="Courier New" w:ascii="Courier New"/>]+CHR(13)+CHR(10)+;
[ <w:lang w:eastAsia="en-US"/>]+CHR(13)+CHR(10)+;
[ <w:color w:val="]+.C2RGB(0, 120, 0,1)+["/>]+CHR(13)+CHR(10)+; && Fore color - RGB
[ <w:sz w:val="]+LTRIM(STR(10*2,11))+["/>]+CHR(13)+CHR(10)+; && Fontsize*2
[ <w:sz-cs w:val="]+LTRIM(STR(10*2,11))+["/>]+CHR(13)+CHR(10)+; && Fontsize*2 
[ <w:strike/>]+CHR(13)+CHR(10)+; && m.llStriked
[ <w:b/>]+CHR(13)+CHR(10)+; && m.llBold
[ <w:i/>]+CHR(13)+CHR(10)+; && m.llItalics
[ <w:u w:val="single"/>]+CHR(13)+CHR(10)+; && m.llUnderline
[ </w:rPr>]+CHR(13)+CHR(10)
      REPLACE XX001 WITH STRTRAN(XX001,"</w:pPr>","</w:pPr>"+CHR(13)+CHR(10)+m.lcPom)

 
      * Change default font for document
      LOCAL m.liStart, m.liEnd, m.lcPom2, m.lihFile, m.lcPom
      m.lihFile=.GetFileHandle("word\styles.xml")
      m.lcPom=""
      =FSEEK(m.lihFile,0)
      DO WHILE NOT FEOF(m.lihFile)
         m.lcPom=m.lcPom+FREAD(m.lihFile,65000)
      ENDDO

      ** Font name
      m.liStart=ATC("<w:rFonts",m.lcPom)+10
      m.lcPom2=SUBSTR(m.lcPom,m.liStart)
      m.liEnd=m.liStart+ATC("/>",m.lcPom2)-1
      m.lcPom=STUFF(m.lcPom,m.liStart,m.liEnd-m.liStart,[w:cs="Courier New" w:hAnsi="Courier New" w:eastAsia="Courier New" w:ascii="Courier New"])

      ** Font Color, strike, bold, italic, underline
      m.liStart=ATC("<w:sz ",m.lcPom)
      m.lcPom2=[ <w:color w:val="]+.C2RGB(0, 0, 255,1)+["/>]+CHR(13)+CHR(10)+;
               [ <w:strike/>]+CHR(13)+CHR(10)+; && m.llStriked
               [ <w:b/>]+CHR(13)+CHR(10)+; && m.llBold
               [ <w:i/>]+CHR(13)+CHR(10)+; && m.llItalics
               [ <w:u w:val="single"/>]+CHR(13)+CHR(10) && m.llUnderline
      m.lcPom=STUFF(m.lcPom,m.liStart,0,m.lcPom2)
 
      ** Font size
      m.liStart=ATC([<w:sz w:val="],m.lcPom)+13
      m.lcPom2=SUBSTR(m.lcPom,m.liStart)
      m.liEnd=m.liStart+ATC(["],m.lcPom2)-1
      m.lcPom=STUFF(m.lcPom,m.liStart,m.liEnd-m.liStart,LTRIM(STR(20*2,11))) && Fontsize*2
 
      m.liStart=ATC([<w:szCs w:val="],m.lcPom)+15
      m.lcPom2=SUBSTR(m.lcPom,m.liStart)
      m.liEnd=m.liStart+ATC(["],m.lcPom2)-1
      m.lcPom=STUFF(m.lcPom,m.liStart,m.liEnd-m.liStart,LTRIM(STR(20*2,11))) && Fontsize*2       
 
      =FSEEK(m.lihFile,0)
      DO WHILE LEN(m.lcPom)>0
         =FWRITE(m.lihFile,LEFT(m.lcPom,65000))
         m.lcPom=SUBSTR(m.lcPom,65001)
      ENDDO 
      ENDWITH
      SELECT (m.liSele)
   ENDPROC 
ENDDEFINE

 

For VFP 5/6/7

m.loSession=EVALUATE([xfrx("XFRX#INIT")]) 
m.lnRetVal = m.loSession.SetParams("test.docx",,,,,,"NATIVE_FDOCX")
IF m.lnRetVal=0 
   m.loSession.setOtherParams("NEXT_PAGE_NAME_EXPR","_HACKPAGENAME(this)")
   m.loSession.ProcessReport("_reports\basetext")
   m.loSession.Finalize()
END IF 

PROCEDURE _HACKPAGENAME(m.loReport)
   LOCAL m.lcPage, m.liSele, m.lcPom
   m.liSele=SELECT()
   
   WITH loreport.odocumentwriter.ooxml
　
   m.lcPage= "Page "+LTRIM(STR(.npageno,11))
    
   IF .npageno=1
      * Attention, all text data must be in UTF-8
      .cEntityStyle="w:styles"
      *m.lcBaseStyle, m.lcBaseName, m.lcHeight (line height in twips), m.lcBefore (before space in twips), m.lcTABSKEY, m.lcTABS, m.llTABs
      .addParagraphStyle("Normal","YourStyle",.ToTWIP(100),"0","","",.F.)

      SELECT (.Alias)

      m.lcPom=;
[ <w:rPr>]+CHR(13)+CHR(10)+;
[ <w:rFonts w:hAnsi="Courier New" w:ascii="Courier New"/>]+CHR(13)+CHR(10)+;
[ <w:lang w:eastAsia="en-US"/>]+CHR(13)+CHR(10)+;
[ <w:color w:val="]+.C2RGB(0, 120, 0,1)+["/>]+CHR(13)+CHR(10)+; && Fore color - RGB
[ <w:sz w:val="]+LTRIM(STR(10*2,11))+["/>]+CHR(13)+CHR(10)+; && Fontsize*2
[ <w:sz-cs w:val="]+LTRIM(STR(10*2,11))+["/>]+CHR(13)+CHR(10)+; && Fontsize*2 
[ <w:strike/>]+CHR(13)+CHR(10)+; && m.llStriked
[ <w:b/>]+CHR(13)+CHR(10)+; && m.llBold
[ <w:i/>]+CHR(13)+CHR(10)+; && m.llItalics
[ <w:u w:val="single"/>]+CHR(13)+CHR(10)+; && m.llUnderline
[ </w:rPr>]+CHR(13)+CHR(10)
      REPLACE XX001 WITH STRTRAN(XX001,"</w:pPr>","</w:pPr>"+CHR(13)+CHR(10)+m.lcPom)

 
      
      * Change default font for document     
      LOCAL m.liStart, m.liEnd, m.lcPom2, m.lihFile, m.lcPom
      m.lihFile=.GetFileHandle("word\styles.xml")
      m.lcPom=""
      =FSEEK(m.lihFile,0)
      DO WHILE NOT FEOF(m.lihFile)
         m.lcPom=m.lcPom+FREAD(m.lihFile,65000)
      ENDDO

      ** Font name 
      m.liStart=ATC("<w:rFonts",m.lcPom)+10
      m.lcPom2=SUBSTR(m.lcPom,m.liStart)
      m.liEnd=m.liStart+ATC("/>",m.lcPom2)-1
      m.lcPom=STUFF(m.lcPom,m.liStart,m.liEnd-m.liStart,[w:cs="Courier New" w:hAnsi="Courier New" w:eastAsia="Courier New" w:ascii="Courier New"])

      ** Font Color, strike, bold, italic, underline
      m.liStart=ATC("<w:sz ",m.lcPom)
      m.lcPom2=[ <w:color w:val="]+.C2RGB(0, 0, 255,1)+["/>]+CHR(13)+CHR(10)+;
               [ <w:strike/>]+CHR(13)+CHR(10)+; && m.llStriked
               [ <w:b/>]+CHR(13)+CHR(10)+; && m.llBold
               [ <w:i/>]+CHR(13)+CHR(10)+; && m.llItalics
               [ <w:u w:val="single"/>]+CHR(13)+CHR(10) && m.llUnderline
      m.lcPom=STUFF(m.lcPom,m.liStart,0,m.lcPom2)
      
      ** Font size
      m.liStart=ATC([<w:sz w:val="],m.lcPom)+13
      m.lcPom2=SUBSTR(m.lcPom,m.liStart)
      m.liEnd=m.liStart+ATC(["],m.lcPom2)-1
      m.lcPom=STUFF(m.lcPom,m.liStart,m.liEnd-m.liStart,LTRIM(STR(20*2,11))) && Fontsize*2
      
      m.liStart=ATC([<w:szCs w:val="],m.lcPom)+15
      m.lcPom2=SUBSTR(m.lcPom,m.liStart)
      m.liEnd=m.liStart+ATC(["],m.lcPom2)-1
      m.lcPom=STUFF(m.lcPom,m.liStart,m.liEnd-m.liStart,LTRIM(STR(20*2,11))) && Fontsize*2      

 
      =FSEEK(m.lihFile,0)      
      DO WHILE LEN(m.lcPom)>0         
         =FWRITE(m.lihFile,LEFT(m.lcPom,65000))         
         m.lcPom=SUBSTR(m.lcPom,65001)      
      ENDDO
   ENDIF 

 
   ENDWITH
   SELECT (m.liSele)
   RETURN lcPage
ENDPROC