Word COM

[Iain Johnstone]

Have added Richard's code in to trap the points he has raised - for which I am truly thankful. I have also got the function to change the font face (bold, italic, underscored), colour and lateral alignment.

When I have tidied it up. I will post it in the Source code forum in case anyone else can use it, with a sample of each type of printout for comparison if I can attach the file.

I forgot to mention that this function is used to print calculation results line by line (or chunk by chunk) The normal printouts are to a standard printer, but it is sometimes useful to have a formatted text output for incorporation into reports.

Many thanks to those above (in the posts, not in Heaven, but it was getting near that!) for your help and interest.

Iain Johnstone

[Richard Angell]

So here's your code with mods that make it do the intended. It now prevents stepping on yourself and crashing it IF you attempt to open a second document (setup flag is true on a subsequent function call before the first document is closed). In order to have multiple documents, you would need use arrays for your object variables so that your calls are directed properly to the correct MS Word object. (e.g. DIM oWordDoc(1 to n) AS Int_Document), as well as pass that value to your function ... i.e. one more param for the index of the MSWord object you want to work with.

But for the moment, see if this gets some wheels turning.

#COMPILE EXE
#DIM ALL
#INCLUDE "msWord.inc"

FUNCTION PBMAIN () AS LONG
    OutputToWord "Hello World"+$CRLF,0,"Arial",16, 1,1,0
    OutputToWord "Hello World"+$CRLF,0,"Arial",16, 1,1,0  ' this test triggers the checking
    OutputToWord "Hello Forum"+$CRLF,0,"Arial",16, 0,1,0
    OutputToWord "",0,"",0, 0,0,1
END FUNCTION

FUNCTION OutputToWord (BYVAL message AS STRING,BYVAL orientationtype AS LONG, BYVAL fontname AS STRING,BYVAL fontsize AS SINGLE, _
                       BYVAL setupflag AS LONG,BYVAL printflag AS LONG,BYVAL closeflag AS LONG) EXPORT AS LONG

'Function usage:-
'Syntax (eg) = OutputToWord Message,0,"Courier New",10,1,1,0
'   where Message is formatted text to print
'         orientation - 0=port, 1=land
'         typeface name
'         fontsize
'         start - 1 to start up Word
'         print - 1 to print text
'         close - 1 to close Word
'so the above example will start Word and print the message in Courier New at 10 points
'        OutputToWord Message,0,"Arial",12,0,1,0  will continue to print in Arial 12 pt
'        OutputToWord Message,0,"Courier New",10,0,0,1  will close Word

    '*** must have STATIC object vars to re-enter this function ... or objects created are not accessible.
    STATIC oWordApp       AS Int_Application ' Application Interface
    STATIC oWordDoc       AS Int_Document    ' Document Interface
    STATIC oWordSel       AS Selection       ' Selection
    STATIC oWordFont      AS Int_Font        'font  or TextEffectFormat?
    STATIC oWordPageSetup AS PageSetup 'set orientation etc
    STATIC oWordOptions   AS Options 'set orientation etc
    STATIC sProgID_Word   AS STRING

    LOCAL vBool     AS VARIANT
    LOCAL vText     AS VARIANT
    LOCAL vFile     AS VARIANT
    LOCAL vFileFmt  AS VARIANT
    LOCAL vVnt      AS VARIANT
    LOCAL result    AS STRING
    LOCAL iDocCount AS LONG
    LOCAL templong  AS LONG


IF setupflag<>0 THEN
' Open an instance of MSWORD ... IF one is not already open! Let's Check!
    IF ISTRUE ISOBJECT(oWordApp) THEN   'no, not with this code ...
        MSGBOX "Tsk, Tsk ... finish the current MSWORD document first!"
        EXIT FUNCTION
      END IF
    oWordApp = NEWCOM $PROGID_Word_Application

    ' Could MSWORD be opened? If not, terminate this app
      IF ISFALSE ISOBJECT(oWordApp) THEN
        MSGBOX "Unable to open or start MSWORD!"
        EXIT FUNCTION
      END IF

    ' Make MSWORD visible in for example normal show state
    oWordApp.Visible = 1
    oWordApp.WindowState = %wdWindowStateNormal


    ' Get the current document count from the "documents collection"
    iDocCount = oWordApp.Documents.Count

     oWordDoc = oWordApp.Documents.Add

     IF ISFALSE ISOBJECT(oWordDoc) THEN
       MSGBOX "MSWORD was not able to start a new document." & $CR & _
                     "Please ensure MSWord and VBA are installed."
       GOTO Terminate
     END IF

      oWordSel = oWordApp.Selection
      IF ISFALSE ISOBJECT(oWordSel) THEN
       MSGBOX "MSWORD was not able to get a Selection." & $CR & _
                     "Please ensure MSWord and VBA are installed."
       GOTO Terminate
     END IF

     oWordFont = oWordSel.Font
     IF ISFALSE ISOBJECT(oWordFont) THEN
       MSGBOX "MSWORD was not able get a font objectt." & $CR & _
                     "Please ensure MSWord and VBA are installed."
       GOTO Terminate
     END IF


    ' Get the current document count from the "documents collection" - This should be one value higher than before
    iDocCount = oWordApp.Documents.Count

'            'set orientation and margins
    oWordDoc.PageSetup.SectionStart = %wdSectionNewPage

    oWordDoc.PageSetup.orientation= orientationtype ' from header

    oWordApp.Options.MeasurementUnit=3   'points

'   'measurements in points
    oWordDoc.PageSetup.TopMargin=72
    oWordDoc.PageSetup.BottomMargin=90
    oWordDoc.PageSetup.LeftMargin=36
    oWordDoc.PageSetup.RightMargin=36
    oWordDoc.PageSetup.Gutter=0

    IF orientationtype=1 THEN 'landscape A4 converted to points
        oWordDoc.PageSetup.PageWidth = (72*11.66)
        oWordDoc.PageSetup.PageHeight = (72*8.25)
    ELSE
        oWordDoc.PageSetup.PageHeight = (72*11.66)
        oWordDoc.PageSetup.PageWidth = (72*8.25)
    END IF
END IF
IF printflag<>0 THEN
'set font - may change through document
     IF oWordFont.Name <> ACODE$(fontname) THEN
         'for Int_Font
         oWordFont.Name= UCODE$(fontname)   'string from header
     END IF
     IF oWordFont.Size <> fontsize THEN
         oWordFont.Size=fontsize    'single from header
     END IF

    'printing starts here
    oWordSel.TypeText(UCODE$(message))
    'Set a paragraph marker (end of paragraph)
    oWordSel.TypeParagraph
END IF

IF closeflag <>0 THEN
'   'print footer - should be centred
    oWordSel.TypeText(UCODE$("Printed from Masterdrain"))
    oWordSel.TypeParagraph

'
' Close the current document and then close MSWORD completely if required
Terminate:
    templong = MSGBOX ("Close MSWORD?",%MB_YESNO OR %MB_TASKMODAL,"Masterdrain")
    IF templong = %IDYES THEN
'save file
        vFile    = "*.doc"      'force tthe saave as dialogh in MS Word
        vFileFmt = %wdFormatDocument
        oWordDoc.SaveAs(vFile, vFileFmt)
        oWordApp.ActiveWindow.CLOSE
        oWordApp.Quit
    ' Close all of the Interfaces
        oWordPageSetup = NOTHING
        oWordFont = NOTHING
        oWordSel  = NOTHING
        oWordDoc  = NOTHING
        oWordApp  = NOTHING
    END IF
  END IF

    FUNCTION = 1
END FUNCTION
'==========================================

[Iain Johnstone]

Thanks Richard - the fog is slowly clearing! I have something to go on, so there goes the rest of the evening!

I suppose the problem starts by taking somebody else's code without understanding how it does the task - not the best way, but we have to start somewhere

Iain Johnstone

[Richard Angell]

In your code, you are only assigning oWordDoc (from your code) :

oWordDoc = oWordApp.Documents.Add

However oWordSel and oWordFont have no such assignment statements, but they should. You have to assign them before trying to access them. The example Fred linked to does this, although it is not using the Direct method you are trying to use.

At least this is what seems to be apparent and different from the working example.

[Iain Johnstone]

Sorry Richard - I have not the faintest idea what you are talking about - this programming aspect is very new to me, and I just lifted the code from the sample program, with modifications.

Can you just give me a push in the right direction?

The oWord.inc is at the beginning of the program. Have also corrected stupid mistake in cleaning up the code to post here - changes STATIC to LOCAL - no, I don't why I did it!

Iain Johnstone

[Richard Angell]

Change oWordFont.Name=fontname to oWordFont.Name=UCODE$(fontname).

First you have an oWordFont assignment, same as for oWordSel ... don't you ? ... neither is being assigned prior to use in the posted code.

[Fred Harris]

demo

Here's another link to what is as far as I know a working demo...

http://www.powerbasic.com/support/pbforums/showthread.php?t=37476

[José Roca]

Change oWordFont.Name=fontname to oWordFont.Name=UCODE$(fontname).

[Richard Angell]

Perhaps it would be good to instantiate the oWord object before trying to use it ?

[Iain Johnstone]

Word COM
I have modified the function below to operate under PB 9, using the example in the Samples section.
This previously worked OK under PB8 using the old syntax. All works now OK except the font setting, which causes the program to fail. The section in question is between the two hash lines.

Can anyone help me to sort this out?

I have included the operating syntax in the unlikely event that anyone else wants to use it once the font is sorted out!

Iain Johnstone

FUNCTION OutputToWord (message AS STRING, orientationtype AS LONG, fontname AS STRING, fontsize AS SINGLE, _
                       setupflag AS LONG,printflag AS LONG,closeflag AS LONG) EXPORT AS LONG

'Function usage:-
'Syntax (eg) = OutputToWord Message,0,"Courier New",10,1,1,0
'   where Message is formatted text to print
'         orientation - 0=port, 1=land
'         typeface name
'         fontsize
'         start - 1 to start up Word
'         print - 1 to print text
'         close - 1 to close Word
'so the above example will start Word and print the message in Courier New at 10 points
'        OutputToWord Message,0,"Arial",12,0,1,0  will continue to print in Arial 12 pt
'        OutputToWord Message,0,"Courier New",10,0,0,1  will close Word


    STATIC oWordApp       AS Int__Application ' Application Interface
    STATIC oWordDoc       AS Int__Document    ' Document Interface
    STATIC oWordSel       AS Selection   ' Selection
    STATIC oWordFont      AS Int__Font        'font  or TextEffectFormat?
    STATIC oWordPageSetup AS PageSetup 'set orientation etc
    STATIC oWordOptions   AS Options 'set orientation etc
    STATIC sProgID_Word   AS STRING

    LOCAL vBool     AS  VARIANT
    LOCAL vText     AS  VARIANT
    LOCAL vFile     AS  VARIANT
    LOCAL vFileFmt  AS  VARIANT
    LOCAL vVnt      AS VARIANT
    LOCAL result    AS STRING
    LOCAL iDocCount AS LONG


    IF setupflag<>0 THEN
    ' Open an instance of MSWORD
        oWordApp = NEWCOM $PROGID_Application

        ' Could MSWORD be opened? If not, terminate this app
          IF ISFALSE ISOBJECT(oWordApp) THEN
            MSGBOX "Unable to open or start MSWORD!"
            EXIT FUNCTION
          END IF

        ' Make MSWORD visible in for example normal show state
        oWordApp.Visible = 1
        oWordApp.WindowState = %wdWindowStateNormal


        ' Get the current document count from the "documents collection"
        iDocCount = oWordApp.Documents.Count

        oWordDoc = oWordApp.Documents.Add

        IF ISFALSE ISOBJECT(oWordDoc) THEN
            MSGBOX "MSWORD was not able to start a new document." & $CR & _
                          "Please ensure MSWord and VBA are installed."
            GOTO Terminate
        END IF

        ' Get the current document count from the "documents collection" - This should be one value higher than before
        iDocCount = oWordApp.Documents.Count

        'set orientation and margins
        oWordDoc.PageSetup.SectionStart = %wdSectionNewPage

        oWordDoc.PageSetup.orientation= orientationtype ' from header

        oWordApp.Options.MeasurementUnit=3   'points

        'measurements in points
        oWordDoc.PageSetup.TopMargin=72
        oWordDoc.PageSetup.BottomMargin=90
        oWordDoc.PageSetup.LeftMargin=36
        oWordDoc.PageSetup.RightMargin=36
        oWordDoc.PageSetup.Gutter=0

        IF orientationtype=1 THEN 'landscape A4 converted to points
            oWordDoc.PageSetup.PageWidth = (72*11.66)
            oWordDoc.PageSetup.PageHeight = (72*8.25)
        ELSE
            oWordDoc.PageSetup.PageHeight = (72*11.66)
            oWordDoc.PageSetup.PageWidth = (72*8.25)
        END IF

    END IF
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    IF printflag<>0 THEN
        'set font - face may change through document
        '###########################################################################
        '?"setting font"
        '
        ''fails here
        '              oWordFont.Name=ucode$(fontname)    'string from header
        '?"fontname set"
        '              oWordFont.Size=fontsize    'single from header
        '?"fontsize set"
        '##########################################################################

        'printing starts here

        oWordSel = oWordApp.Selection
        oWordSel.TypeText(UCODE$(message))
     '  Set a paragraph marker (end of paragraph)
        oWordSel.TypeParagraph
    END IF
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~##
    IF closeflag <>0 THEN
        ' print footer - should be centred
        oWordSel.TypeText(UCODE$("Printed from Masterdrain"))
        oWordSel.TypeParagraph

    '
    ' Close the current document and then close MSWORD completely if required
        templong=MSGBOX ("Close MSWORD?",%MB_YESNO OR %MB_TASKMODAL,"Masterdrain")
        IF templong=%IDYES THEN
    'save file
            result=INPUTBOX$("Enter filename to save","About to save the document...", "Output.doc") 'this is untidy
            IF RIGHT$(result,4)<>".doc" THEN result=result+".doc"
            vFile    = result
            vFileFmt = %wdFormatDocument
            oWordDoc.SaveAs(vFile, vFileFmt)

            oWordApp.ActiveWindow.CLOSE
            oWordApp.Quit
        ' Close all of the Interfaces
            oWordSel  = NOTHING
            oWordDoc  = NOTHING
            oWordApp  = NOTHING
            oWordFont = NOTHING
            oWordPageSetup = NOTHING
        END IF
      END IF
      FUNCTION =1:EXIT FUNCTION
      
Terminate:
            oWordApp.ActiveWindow.CLOSE
            oWordApp.Quit
        ' Close all of the Interfaces
            oWordSel  = NOTHING
            oWordDoc  = NOTHING
            oWordApp  = NOTHING
            oWordFont = NOTHING
            oWordPageSetup = NOTHING

    FUNCTION =1
END FUNCTION
'=======================================================