multi images detecting inside word document

[Silvester Roklasfonoshio]

Hi everybody i have implemented this code to detect more than one image:

#define Word_File hb_dirbase() + "MyFileTxt.docx"
procedure Main
   local oWord
   local oDoc
   local oImgs
   local oShape
   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.
   oDoc          := oWord:documents:open( Word_File )
   if oDoc:InlineShapes:Count > 0

      oImgs := oWord:Documents:Add()
      for each oShape in oDoc:InlineShapes

         oShape:Range:CopyAsPicture()
         oImgs:Paragraphs:Add()
         oWord:Selection:Paste()
      endfor
    endif
   oWord := NIL
   return

it just only works with one image and when i tested with more than one image i got this erroe:

Error 121896500/0 S_OK: PASTE

why and how i can modify this code to make it able to work with more than one image?

[Silvester Roklasfonoshio]

I am still waiting for any answer or suggestion

[AL67]

środa, 5 kwietnia 2023 o 22:39:14 UTC+2 Silvester Roklasfonoshio napisał(a):

Hi everybody i have implemented this code to detect more than one image:

#define Word_File hb_dirbase() + "MyFileTxt.docx"
procedure Main
   local oWord
   local oDoc
   local oImgs
   local oShape
   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.
   oDoc          := oWord:documents:open( Word_File )
   if oDoc:InlineShapes:Count > 0

      oImgs := oWord:Documents:Add()
      for each oShape in oDoc:InlineShapes

         oShape:Range:CopyAsPicture()
         oImgs:Paragraphs:Add()
         oWord:Selection:Paste()

 Wher is Selection() ?  Wher You paste() image ?

maybe write:   oImgs:Selection:Paste()

      endfor
    endif
   oWord := NIL
   return

it just only works with one image and when i tested with more than one image i got this erroe:

Error 121896500/0 S_OK: PASTE

why and how i can modify this code to make it able to work with more than one image?

Adam

[Silvester Roklasfonoshio]

Thank you very much for your answer my dear brother ... the code pastes the image in new word document that is why what you suggest will not work ,the code works perfectly with one image i mean when the word document has one image it can correctly extract that image and paste it in new word document but when the document has more than one image it just paste the first image and give me the previous error i show you previously :
Error 121896500/0 S_OK: PASTE

and i dont know why ? so what do suggest ? where is the problem exactly ?

[Bernard Mouille]

Hello Sylvester,

It works in my computer.

Regads,

Bernard.
// Compile with -lhbwin

#define  Word_File hb_dirbase() + "MyFileTxt.docx"

#include "hbgtinfo.ch"
procedure Main
   local oWord, oDoc, oImgs, oShape

   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.
   oDoc          := oWord:documents:open( Word_File )
   if oDoc:InlineShapes:Count > 0
      oImgs := oWord:Documents:Add()
      for each oShape in oDoc:InlineShapes
         oShape:Range:CopyAsPicture()
         oImgs:Paragraphs:Add()
         oWord:Selection:Paste()

         hb_gtInfo( HB_GTI_CLIPBOARDDATA, "" )

      endfor
    endif
   oWord := NIL
   return

[Silvester Roklasfonoshio]

Thank you very much for your answer my dear brother i really appreciate that but unfortunately the error still there and still there it just copy one image to the new word document

121203724/0 S_OK: PASTE 
i follow all your guide so what should i do?

[Bernard Mouille]

Hello Silvester,

Can you try the new code in the attached file and say if it works ?

Regards,

Bernard.

[Silvester Roklasfonoshio]

Thank you for your precious answer again my dear brother i am really so grateful for that but unfortunately it does not work it gave me the following error:

Borland Resource Compiler  Version 5.40
Copyright (c) 1990, 1999 Inprise Corporation.  All rights reserved.
C:\Users\Lenovo\AppData\Local\Temp\hbmk_0r3gxx.dir\testermodel.c:
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 670: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 683: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 686: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 687: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 688: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 753: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 754: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 755: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 756: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 757: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 758: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
Error E2140 e:\\d\\myfourthpaper\\themodel\\testermodel.PRG 759: Declaration is not allowed here in function HB_FUN_CBITMAPTOBMP
*** 12 errors in Compile ***
C:\Users\Lenovo\AppData\Local\Temp\hbmk_8inxor.c:

[Bernard Mouille]

ok Sylvester,

I think that the default is in Borland.

Maybe a parameter not good.

I use hb32 night edition or hb3.0.0. and it works fine.

Try to test with hb and MinGw.

Regards,

Bernard.

[Silvester Roklasfonoshio]

Thank you very much my dear brother for your answer ,i think we complicate the issue this code :

#define Word_File hb_dirbase() + "MyFileTxt.docx"
procedure Main
   local oWord
   local oDoc
   local oImgs
   local oShape
   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.
   oDoc          := oWord:documents:open( Word_File )
   if oDoc:InlineShapes:Count > 0

      oImgs := oWord:Documents:Add()
      for each oShape in oDoc:InlineShapes

         oShape:Range:CopyAsPicture()
         oImgs:Paragraphs:Add()
         oWord:Selection:Paste()

      endfor
    endif
   oWord := NIL

   return

 was working fine and successed in extract one image it just failed to extract more than one image i think there is some error in the code itself if you can check it maybe you could find out what is the problem exactly maybe it needs to modified little thing will solve the problem because i can not use what you said  and i do not know how.

[Bernard Mouille]

Hello Silvester,

You can also try the code below my signature.

Regards,

Bernard.

// This code is a basic sample.
// Compile with hbziparc.hbc -lhbwin

#define Word_File hb_dirbase() + "MyFileTxt.docx"

procedure Main
   local i
   local aDirs, aFiles
   local oWord, oImgs
   local Img_Types := { ".bmp", ".gif", ".jpeg", ".jpg", ".png", ".tiff" } // To be continued...
   if .not. bh_UnzipAll( Word_File, hb_dirbase() + "WordFiles", @aDirs, @aFiles )
      wapi_MessageBox( 0, "bh_UnzipAll() failed, abort." )
      return
   endif

   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.

   oImgs         := oWord:Documents:Add()

   for i := 1 to len( aFiles )
      if bh_IsFileType( aFiles[ i ], Img_Types )
         oImgs:InlineShapes:AddPicture ( aFiles[ i ] )
      endif
   endfor
   oWord := nil
   return
// Return .T. if the type file is found.
function bh_IsFileType( cFile, aTypes )
   local i
   local lResult := .F.
   for i := 1 to len( aTypes )
      if lower( right( cFile, len( aTypes[ i ] ) ) ) == aTypes[ i ]
         lResult := .T.
         exit
      endif
   endfor
   return lResult
// Extract all files and folders from a compressed file.
function bh_UnzipAll( cFileZip, cDirFiles, aDirs, aFiles )
   local i                  // Numeric count.
   local aSubDirs := {}     // Sub directories of the comprssed file.
   local cDir               // Directory in work.
   local lSuccess           // Return .T. if ok.
   aDirs    := {}
   aFiles   := hb_GetFilesInZip( cFileZip )
   hb_DirRemoveAll( cDirFiles )
   // Gets the sub folders of the compressed file.
   for i := 1 to len( aFiles )
      if hb_at( "/", aFiles[ i ] ) > 0
         cDir := substr( aFiles[ i ], 1, hb_rat( "/", aFiles[ i ] ) - 1 )
         if hb_ascan( aSubDirs, cDir,,, .T. ) == 0
            aadd( aSubDirs, cDir )
         endif
      endif
   endfor
   // Gets all the folders of the compressed file.
   for i := 1 to len( aSubDirs )
      cDir := aSubDirs[ i ]
      do while .T.
         if hb_at( "/", cDir ) > 0
            if hb_ascan( aDirs, cDir,,, .T. ) == 0
               aadd( aDirs, cDir )
            endif
         else
            if hb_ascan( aDirs, cDir,,, .T. ) == 0
               aadd( aDirs, cDir )
            endif
            exit
         endif
         cDir := substr( cDir, 1, hb_rat( "/", cDir ) - 1 )
      enddo
   endfor
   asort( aDirs )
   // Create the directories.
   hb_dirCreate( cDirFiles )
   cDirFiles += "\"
   for i := 1 to len( aDirs )
      hb_dirCreate( cDirFiles + strtran( aDirs[ i ], "/", "\" ) )
   endfor
   lSuccess := hb_UnzipFile( cFileZip,, .T.,, cDirFiles, aFiles )
   for i := 1 to len( aFiles )
      aFiles[ i ] := cDirFiles + strtran( aFiles[ i ], "/", "\" )
   endfor
   for i := 1 to len( aDirs )
      aDirs[ i ] := cDirFiles + strtran( aDirs[ i ], "/", "\" )
   endfor
   return lSuccess

[Silvester Roklasfonoshio]

Thank you very much for your precious answer my dear brother i had tried your code and i got this error:

Error: Unresolved external '_HB_FUN_WAPI_MESSAGEBOX' referenced from C:\USERS\LENOVO\APPDATA\LOCAL\TEMP\HBMK_BVZVIV.DIR\THEOTHERMODEL.OBJ
Error: Unresolved external '_HB_FUN_HB_DIRREMOVEALL' referenced from C:\USERS\LENOVO\APPDATA\LOCAL\TEMP\HBMK_BVZVIV.DIR\THEOTHERMODEL.OBJ

it look like the two function wapi _messagebox and hb_dirremoveall need to be identified 

so please solve this problem thank you again my dear brother

[Bernard Mouille]

My hbp file to compile :

# Test.hbp - Compilation de Test.EXE.
# -----------------------------------
#
# Nom du programme avec éventuellement son chemin.
#
-oTest
#
# Affiche tous les warnings.
#
-w3
#
# Ne fabrique pas l'exe si warning.
#
-es2
#
# Programme maître.
#
Test.prg
#
# Librairies : respecter l'ordre.
#
-lhbwin
hbziparc.hbc

[Silvester Roklasfonoshio]

Thank you my brother for your answer ,just give me the source code of the definition of two functions

WAPI_MESSAGEBOX and HB_DIRREMOVEALL

so i can include them in my code 

thank you very much my dear brother

[Bernard Mouille]

You can find the code in the HB32 nigtly source.

I have replace the two functions.

Regards,

Bernard.

// Begin code.

// This code is a basic sample.
// Compile with hbziparc.hbc -lhbwin

#define Word_Files_Folder hb_dirbase() + "WordFiles"

procedure Main
   local i
   local aDirs, aFiles

   local nHeight, nResH, nResV, nWidth
   local oWord, oSele

   local Img_Types := { ".bmp", ".gif", ".jpeg", ".jpg", ".png", ".tiff" } // To be continued...

   local Word_File := win_GetOpenFileName( , "Select a Word file",,, { "Word files ; *.docx" } )
   setmode( 25, 80 )
   if .not. file( Word_File )
      alert( "Word file not found, abort." )
      return
   endif
   if .not. bh_UnzipAll( Word_File, Word_Files_Folder, @aDirs, @aFiles )
      alert( "bh_UnzipAll() failed, abort." )

      return
   endif
   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.

   oWord:Documents:Add()
   oSele := oWord:Selection
   oSele:TypeText( "Images for " + Word_File )

   for i := 1 to len( aFiles )

      if bh_IsFileType( aFiles[ i ], Img_Types )

         oSele:TypeParagraph()
         oSele:InlineShapes:AddPicture ( aFiles[ i ] )
         oSele:TypeParagraph()
         oSele:TypeText( "File " + aFiles[ i ] )
         oSele:TypeParagraph()
         if bh_GetImageInfos( aFiles[ i ], @nHeight, @nWidth, @nResH, @nResV )
            oSele:TypeText( "Height "    + hb_ntos( nHeight )+ " px, " )
            oSele:TypeText( "Width "     + hb_ntos( nWidth )+ " px, " )
            oSele:TypeText( "Hor Res "   + hb_ntos( nResH )+ " px/inch, " )
            oSele:TypeText( "Vert Res "  + hb_ntos( nResV )+ " px/inch." )
         else
            oSele:TypeText( "*** Error *** Cannot load the image informations." )
         endif
         oSele:TypeParagraph()

      endif
   endfor
   oWord := nil

   bh_DelTree( Word_Files_Folder )
   return
// Remove a complete directory.
procedure bh_DelTree( cDir )
   if hb_DirExists( cDir )
      bh_Run( 'cmd /K RMDIR /S /Q "' + cDir + '" &exit', 0, .T. )
   endif
   return
// Get the image informations.
function bh_GetImageInfos( cFile, nHeight, nWidth, nResH, nResV )
   local lSuccess := .F.
   local oImg     := Win_OleCreateObject( "WIA.ImageFile" )
   BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }  // Try.
      oImg:LoadFile( cFile )
      nHeight := oImg:Height
      nWidth  := oImg:Width
      nResH   := oImg:HorizontalResolution
      nResV   := oImg:VerticalResolution
      lSuccess := .T.
   END                // Endtry.
   oImg := nil
   return lSuccess

// Return .T. if the type file is found.
function bh_IsFileType( cFile, aTypes )
   local i
   local lResult := .F.
   for i := 1 to len( aTypes )

      if lower( right( cFile, len( aTypes[ i ] ) ) ) == lower( aTypes[ i ] )

         lResult := .T.
         exit
      endif
   endfor
   return lResult

// Run a command with option display and stop.
procedure bh_Run( cCommand, nDisplay, lStop )
   if lStop == nil
      lStop := .T.
   endif
   if nDisplay == nil
      nDisplay := 1
   endif
   win_oleCreateObject( "WScript.Shell" ):Run( cCommand, nDisplay, lStop )
   return

// Extract all files and folders from a compressed file.
function bh_UnzipAll( cFileZip, cDirFiles, aDirs, aFiles )
   local i                  // Numeric count.
   local aSubDirs := {}     // Sub directories of the comprssed file.
   local cDir               // Directory in work.
   local lSuccess           // Return .T. if ok.
   aDirs    := {}
   aFiles   := hb_GetFilesInZip( cFileZip )

   bh_DelTree( cDirFiles )

   asort( aFiles )

   for i := 1 to len( aDirs )
      aDirs[ i ] := cDirFiles + strtran( aDirs[ i ], "/", "\" )
   endfor
   return lSuccess

// End code.

[Bernard Mouille]

For the 2 functions, I attach the code :

hb_DirRemoveAll   D:\hb32_src\src\rtl\dirscan.prg
WAPI_MESSAGEBOX   D:\hb32_src\contrib\hbwin\wapi_winuser_2.c

[Silvester Roklasfonoshio]

Thank you very much for your answer my brother but when i include the code of two function you give me it give me the following error

it can not open  the file "include "hbwapi.h""

and when i used the other code which does not have the two function it give me the following error

Error BASE/1111 Argument error: LEN

Error Details:
Called From: Goal: Main Step: IF ( .not. bh_UnzipAll(GetFile, hb_dirbase() + 'WordFiles', @aDirs, @aFiles ) ) Resistance: Circuits\Main\Main\Main ( PEXTRACT() , 94 )
Called From: Goal: Main Step: Button Properties Resistance: Circuits\Main\Main\Main ( (b)R_THEOTHERMODEL_19ART1() , 69 )
Called From: Goal: Main Step: Activate window Resistance: Circuits\Main\Main\Main ( R_THEOTHERMODEL_19ART1() , 78 )

[Bernard Mouille]

Sorry Silvester,

My codes works in Harbour 32 dev nightly.

I do not look that I can do for you now.

Regards,

Bernard.

[Silvester Roklasfonoshio]

Thank you very much my brother for your precious answer ,let us simplified the problem ,no need to give me every time new code just let us concentrate  in one code  the first cod was perfect i mean this code:

#define Word_File hb_dirbase() + "MyFileTxt.docx"
procedure Main
   local oWord
   local oDoc
   local oImgs
   local oShape

   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.

   oDoc          := oWord:documents:open( Word_File )
   if oDoc:InlineShapes:Count > 0

      oImgs := oWord:Documents:Add()
      for each oShape in oDoc:InlineShapes

         oShape:Range:CopyAsPicture()
         oImgs:Paragraphs:Add()
         oWord:Selection:Paste()
      endfor
    endif
   oWord := NIL
   return

it works with one photo and its problem is giving error when i use it with a document contains more than one photo where it give me this error
Error 121896500/0 S_OK: PASTE
so let us solve this problem only without changing all code because this will bring other problems for us i think you can do that by saving the photos in array and paste it
one by one so the change  will be only in the following part

 oShape:Range:CopyAsPicture()
         oImgs:Paragraphs:Add()
         oWord:Selection:Paste()

 no need to add any thing else just focus on the previous part i hope you got what i mean

[Silvester Roklasfonoshio]

I am still waiting for your answer just little modification in the first working code no need to give me new code please my brother help me

[Bernard Mouille]

Silvester,

I am sorry but I think that your harbour version is not good.

What version you use and where I can download it ?

What version of Windows you use ?

Regards,

Bernard.

[Silvester Roklasfonoshio]

I am using harbour  under PWCT(Programing without coding technology)you can download this program from this site

https://sourceforge.net/projects/doublesvsoop/

i am using windows 10 Windows Feature Experience Pack 120.2212.4190.0

but i thing what i told you is so simple if you just copy the image in array and paste it one by one just try to do that and i am sure it will work

[Bernard Mouille]

I had dowload and look PWCT samples : I have no time to learn this tool because I am learning WebView2 with HMG in this moment.

Here is Harbour forum and not xHarbour forum : I do not use xHarbour.

Regards,

Bernard.

[Silvester Roklasfonoshio]

Thank you very much for your cooperation you tried to help me a lot i really appreciate that but i had already ask my question in a xHarbour forum and no body answer me you are only the person who work hard to help me i think my problem is so simple if you just save the images in array and paste them one by one it will work just do it in harbour and i will take it from there and i will solve any problem by myself from there please do this last thing for me and you will not see me again i promise

or give me some body you know or some good xharbour  forum you know thank you very much again and i really appreciate your help

[Bernard Mouille]

To look the mistake, can you join a zif file with your project files and a test Word file ?

PCWT is installed in C:\PWCT19

I use Windows 10

I do not understand how to create a program and compile with PCWT.

[Bernard Mouille]

Maybe the new code works better.

// begin code.

#define Word_File hb_dirbase() + "MyFileTxt.docx"

#define msoLinkedPicture 11   // Linked picture.
#define msoPicture       13   // Picture.

procedure Main
   local oWord
   local oDoc
   local oImgs
   local oShape

   setmode( 43, 80 )

   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.

   oDoc          := oWord:documents:open( Word_File,, .T. )
   if oDoc:Shapes:Count > 0
      for each oShape in oDoc:Shapes
         if oShape:Type == msoLinkedPicture .or. oShape:Type == msoPicture
            oShape:ConvertToInlineShape()
         endif
      endfor
   endif

   if oDoc:InlineShapes:Count > 0
      oImgs := oWord:Documents:Add()
      for each oShape in oDoc:InlineShapes
         oShape:Range:CopyAsPicture()
         oImgs:Paragraphs:Add()
         oWord:Selection:Paste()

         oImgs:Paragraphs:Add()
      endfor
    endif
   oWord := nil
   return

// end code.

[Silvester Roklasfonoshio]

Hi my dear brother ,thank you ...thank you...thank you finaly it works perfectly there is no word in any language that can express my deep thanks for you ...you are the best friend i have ever met in my life .

can i just ask you the last thing how can i get the location of each photo extracted from the word document i mean is there any way to know the location of each photo the previous code extracted from the word document after how many line the photo start ?

thank you again my dear dear brother

[Silvester Roklasfonoshio]

I am still waiting for your answer my dear brother ,i Know maybe i bother you a lot with my questions but after we solve the major one i think my last one is so simple in compare of the main problem which we solve it already so how we can know the location of each photo in the word document ?

[Silvester Roklasfonoshio]

I am still waiting for your answer my dear brother

[Bernard Mouille]

I do not use that you want and I do know how to do it.

Maybe somebody has an answer ?

[Silvester Roklasfonoshio]

Thank you very much for your response my brother ....i have notice that you used object in all codes you give me even in the last one that works perfectly with me can you tell me which is the class you use and all its functions ...can you give me some link for some sites explain that simply and clearly

[Bernard Mouille]

Document object (Word) | Microsoft Learn

[Silvester Roklasfonoshio]

Thank you very much for your wonderful answer just small question ...how can i write string in word document by OLE object?

[Bernard Mouille]

Hello Silverster,

A basic code.

Regards,

Bernard.

// Begin code

/*
   Test.prg
   Sample to create a MS Word file.
   Using HB32, Windows10, MS Word 2007.

   Compile with -lhbwin

   This code is a basic sample for tests.

   Word      : https://learn.microsoft.com/en-us/office/vba/api/word.application
   Document  : https://learn.microsoft.com/en-us/office/vba/api/word.document
   Fonts     : https://learn.microsoft.com/en-us/office/vba/api/Word.Font
   Selection : https://learn.microsoft.com/en-us/office/vba/api/word.selection
   Paragraph : https://learn.microsoft.com/en-us/office/vba/api/Word.Paragraph
*/

// Parameter.
#define BM_FILE_WORD hb_dirbase() + "_Result_Word.docx"         // File to create with his path.

// https://learn.microsoft.com/en-us/office/vba/api/word.wdbreaktype
#define wdLineBreak 6  // Line break.
#define wdPageBreak 7  // Page break at the insertion point.

// https://learn.microsoft.com/en-us/office/vba/api/Word.WdHeaderFooterIndex
#define wdHeaderFooterPrimary 1  // Returns the header or footer on all pages other
                                 // than the first page of a document or section.

// https://learn.microsoft.com/en-us/office/vba/api/word.wdparagraphalignment
#define wdAlignParagraphCenter 1  // Center-aligned.
#define wdAlignParagraphLeft   0  // Left-aligned.

procedure Main
   local oWord          // Word object.
   local oDoc           // Document object.
   local oSele          // Selection object.

   setmode( 25, 80 )
   setcolor( "GR+/B" )
   @ 0, 0, maxrow(), maxcol() box space( 9 )

   ? "Sample to create a MS Word file."

   ferase( BM_FILE_WORD )

   oWord         := win_olecreateobject( "Word.Application" )
   oWord:Visible := .T.
   oDoc          := oWord:documents:add()
   oWord:ActiveDocument:Select()

   // Option : Page number at the end of page.
   oDoc:Sections( 1 ):Footers( wdHeaderFooterPrimary ):PageNumbers:Add()

   // Option : Margins.
   oDoc:PageSetup:LeftMargin   := oWord:Application:CentimetersToPoints( 1 )
   oDoc:PageSetup:RightMargin  := oWord:Application:CentimetersToPoints( 1 )
   oDoc:PageSetup:TopMargin    := oWord:Application:CentimetersToPoints( 1 )
   oDoc:PageSetup:BottomMargin := oWord:Application:CentimetersToPoints( 1 )

   // Write something.
   oWord:Selection:Font:Bold := .T.
   oWord:Selection:Font:Size := 26
   oWord:Selection:typetext( "First document" )

   oWord:Selection:InsertBreak( wdLineBreak ) // Line change.
   oWord:Selection:InsertBreak( wdLineBreak ) // Line change.
   oWord:Selection:InsertBreak( wdLineBreak ) // Line change.
   oWord:Selection:InsertBreak( wdLineBreak ) // Line change.

   // Use the oSele object more short.
   oSele := oWord:Selection

   // Create a paragraph.
   oSele:TypeParagraph()
   oSele:Font:Bold := .F.
   oSele:Font:Size := 12
   oSele:Font:Name := "Courier New"
   oSele:typetext( "This is the line after 4 eol() and a new paragraph." )

   oSele:InsertBreak( wdPageBreak ) // Page change.

   oSele:TypeParagraph()
   oSele:Font:Name := "Verdana"
   oSele:ParagraphFormat:Alignment := wdAlignParagraphCenter
   oSele:typetext( "This line is center." )

   oSele:TypeParagraph()
   oSele:ParagraphFormat:Alignment := wdAlignParagraphLeft
   oSele:typetext( "Look this program header the Microsoft links and good play." )

   oDoc:SaveAs( BM_FILE_WORD )

//   oDoc:Close( .T. )
//   oWord:Quit()
   oWord := nil

   return

// End code

[Silvester Roklasfonoshio]

Thank you very much i had implement your code and it works well but when i adjust it with the previous code that you gave me before either it give me error or it write the text in the other document ,what i want is to extract the photo from the document and write text in its previous place after cutting the images from it so how can i adjust this code to do that:

#define Word_File hb_dirbase() + "MyFileTxt.docx"
#define msoLinkedPicture 11   // Linked picture.
#define msoPicture       13   // Picture.

procedure Main
   local oWord
   local oDoc
   local oImgs
   local oShape
   setmode( 43, 80 )

   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.
   oDoc          := oWord:documents:open( Word_File,, .T. )
   if oDoc:Shapes:Count > 0
      for each oShape in oDoc:Shapes
         if oShape:Type == msoLinkedPicture .or. oShape:Type == msoPicture
            oShape:ConvertToInlineShape()
         endif
      endfor
   endif

   if oDoc:InlineShapes:Count > 0
      oImgs := oWord:Documents:Add()
      for each oShape in oDoc:InlineShapes

         oShape:Range:Cut() 

         oImgs:Paragraphs:Add()
         oWord:Selection:Paste()
         oImgs:Paragraphs:Add()
      endfor
    endif
   oWord := nil
   return
// end code.

[Bernard Mouille]

Hello Silvester,

You can try the code below my signature.

Regards,

Bernard.

// Begin code.

/*
   MW_ExtractImages.prg
   Sample to extract images of a Word file.

   Using HB32, Windows10, MS Word 2007.

   Compile with -lhbwin

   This code is a basic sample for tests.

   Copy the constants files from my web site.

   web : http://bernard.mouille.free.fr/mso-hb32/MW_ExtractImages.txt
   Last change : 2023-05-27
*/

#define BM_FILE_WORD hb_dirbase() + "_Result_Word.docx"  // File to create with his path.

#include "hbgtinfo.ch"

#include "mw_WordConstants.h"             // http://bernard.mouille.free.fr/mso-hb32/mw_WordConstants.h
#include "mo_MicrosoftOfficeConstants.h"  // http://bernard.mouille.free.fr/mso-hb32/mo_MicrosoftOfficeConstants.h

procedure Main
   local oWord            // Word object.

   local oDoc             // Document to extract images.
   local oImgs            // Document to put images.
   local oShape           // Shape and InlineShape object.

   local oSele            // Selection object.

   local Word_File        // File to extract images.
   local nShapes   := 0   // Shapes images count.
   local nInShapes := 0   // InShapes images count.

   setmode( 25, 80 )
   setcolor( "GR+/B" )
   @ 0, 0, maxrow(), maxcol() box space( 9 )

   ? "Sample to extract images of a Word file."

   ferase( BM_FILE_WORD )

   Word_File := win_GetOpenFileName( , "Select a Word file",,, { "Word files ; *.docx" } )

   if .not. file( Word_File )

      wapi_MessageBox( 0, "Word file not found, abort." )
      return
   endif

   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.

   oDoc          := oWord:documents:open( Word_File,, .T. )  // Read only open.

   // Select the document to write text.

   oImgs := oWord:Documents:Add()

   oImgs:Select()
   oSele := oWord:Selection

   // Option : Page number at the end of page.

   oImgs:Sections( 1 ):Footers( wdHeaderFooterPrimary ):PageNumbers:Add()

   // Option : Margins.
   oImgs:PageSetup:LeftMargin   := oWord:Application:CentimetersToPoints( 1 )
   oImgs:PageSetup:RightMargin  := oWord:Application:CentimetersToPoints( 1 )
   oImgs:PageSetup:TopMargin    := oWord:Application:CentimetersToPoints( 1 )
   oImgs:PageSetup:BottomMargin := oWord:Application:CentimetersToPoints( 1 )

   oSele:Font:Bold  := .T.
   oSele:Font:Size  := 18
   oSele:typetext( "Extrat all pictures of a Word file." )

   oSele:TypeParagraph()
   oSele:Font:Bold  := .F.

   oSele:Font:Size  := 11
   oSele:typetext( "File " + Word_File )

   oWord:Selection:InsertBreak( wdLineBreak )

   oSele:typetext( "Date " + hb_ttoc( hb_datetime() ) )

   if oDoc:Shapes:Count > 0
      for each oShape in oDoc:Shapes
         if oShape:Type == msoLinkedPicture .or. oShape:Type == msoPicture

            nShapes ++
         endif
      endfor
   endif

   oSele:TypeParagraph()
   oSele:typetext( "Image(s) in Shapes " + hb_ntos( nShapes ) )

   oWord:Selection:InsertBreak( wdLineBreak )

   if oDoc:InlineShapes:Count > 0

      for each oShape in oDoc:InlineShapes

         if oShape:Type == wdInlineShapePicture
            nInShapes ++
         endif
      endfor
   endif

   oSele:typetext( "Image(s) in InlineShapes " + hb_ntos( nInShapes ) )

   oWord:Selection:InsertBreak( wdLineBreak )

   oSele:typetext( "Total image(s) in the document : " + hb_ntos( nShapes + nInShapes ) )

   // https://learn.microsoft.com/en-us/office/vba/api/word.shape

   if oDoc:Shapes:Count > 0
      for each oShape in oDoc:Shapes
         if oShape:Type == msoLinkedPicture .or. oShape:Type == msoPicture
            oShape:ConvertToInlineShape()
         endif
      endfor
   endif

   // https://learn.microsoft.com/en-us/office/vba/api/Word.InlineShape

   if oDoc:InlineShapes:Count > 0

      nShapes := 0
      for each oShape in oDoc:InlineShapes
         if oShape:Type == wdInlineShapePicture
            oSele:InsertBreak( wdPageBreak )
            nShapes ++
            oSele:typetext( "Insetion of mage number " + hb_ntos( nShapes ) +  " in the document" )
            oSele:InsertBreak( wdLineBreak )
            oSele:typetext( "Height " + hb_ntos( oShape:Height ) )
            oSele:InsertBreak( wdLineBreak )
            oSele:typetext( "Width  " + hb_ntos( oShape:Width  ) )
            oSele:InsertBreak( wdLineBreak )
            oSele:InsertBreak( wdLineBreak )

            oSele:Paragraphs:Add()
            oShape:Range:CopyAsPicture()
            oSele:Paragraphs:Add()
            oWord:Selection:Paste()
            oSele:InsertBreak( wdLineBreak )
            oSele:InsertBreak( wdLineBreak )

            oImgs:Paragraphs:Add()
            oSele:typetext( "End of insetion of mage number " + hb_ntos( nShapes ) +  " in the document" )
            hb_gtInfo( HB_GTI_CLIPBOARDDATA, "" ) // Empty clipboard.
         endif
      endfor
   endif

   oDoc:Close( wdDoNotSaveChanges )
   oImgs:SaveAs( BM_FILE_WORD )
   oWord := nil

   return

// End code.

[Silvester Roklasfonoshio]

Thank you very much my dear brother for your precious answer i wrote simple code from your long code and this code is extracting the image from word file and writing in the file but what i want is the writing to be in the place of the extracting image so can you just modify the following code in to make it able to write in the place of the image not in the beginning of the document ,please just modify the code dont give me other one in order to avoid any error:
Local oDoc,oWord,oShape
GetFolder := C_BrowseForFolder( NIL, ;
" Select Folder" , NIL, NIL, ;
, NIL )
GetFile := GetFile (  , ;
, ;
, ;
, ;
)
oWord := TOLEAUTO():NEW( "Word.application" )
oShape := TOLEAUTO():NEW( "Shape" )
oWord:Visible := .T.
oDoc := oWord:documents:add()
oDoc=oWord:Documents:Open(GetFile)

for each oShape in oDoc:InlineShapes

oWord:Selection:Font:Bold := .T.
oWord:Selection:Font:Size := 26

oShape:Range:Cut()
oWord:InsertBreak( wdLineBreak )
oWord:Selection:typetext( "P" )
oWord:InsertBreak( wdLineBreak )
endfor

return

 

[Bernard Mouille]

Hello Silvester,

A basic sample below my signature.

My codes arent basic samples in Harbour 32.

Modify that it do not works if you use another tool that Harbour 32.

Regards,

Bernard.

// Begin code.

/*
   MW_ReplaceImagesWithText.prg
   Sample to replace images with text in Word file.

   Using HB32, Windows10, MS Word 2007.
   Compile with -lhbwin

   This code is a basic sample for tests.

   Copy the constants files from my web site.

   web : http://bernard.mouille.free.fr/mso-hb32/MW_ReplaceImagesWithText.txt
   Last change : 2023-06-02
*/

// Parameters.
#define BM_FILE_WORD hb_dirbase() + "_Result_Word.docx"  // Copy of the file to replace images with text.
#define BM_FILE_LOG  hb_dirbase() + "_Result_Log.log"    // Log file for look whats happen.

#include "mw_WordConstants.h"             // http://bernard.mouille.free.fr/mso-hb32/mw_WordConstants.h
#include "mo_MicrosoftOfficeConstants.h"  // http://bernard.mouille.free.fr/mso-hb32/mo_MicrosoftOfficeConstants.h

procedure Main
   local oWord                 // Word object.
   local oDoc                  // Document to extract images.

   local oShape                // Shape and InlineShape object.

   local Word_File             // File to extract images.

   local oSentence             // Sentence object.
   local aStentences           // Array with the sentences positions.
   local nShape                // Shape while number.
   local nSentence             // Sentences while number.

   setmode( 25, 80 )
   setcolor( "GR+/B" )
   @ 0, 0, maxrow(), maxcol() box space( 9 )

   ferase( BM_FILE_LOG  )
   ferase( BM_FILE_WORD )
   set( _SET_EOF      , .F.         )
   set( _SET_ALTFILE  , BM_FILE_LOG )
   set( _SET_ALTERNATE, .T.         )

   ? "Sample to replace images with text in Word file."
   ?

   Word_File := win_GetOpenFileName( , "Select a Word file",,, { "Word files ; *.docx" } )
   if .not. file( Word_File )
      wapi_MessageBox( 0, "Word file not found, abort." )
      return
   endif

   hb_fcopy( Word_File, BM_FILE_WORD )

   oWord         := Win_OleCreateObject( "Word.Application" )
   oWord:Visible := .T.

   oDoc          := oWord:documents:open( BM_FILE_WORD )

   if oDoc:Shapes:Count > 0

      ? "Puts all the document sentences to an array for the shapes."
      ?
      aStentences := {}
      for each oSentence in oDoc:Sentences
         aadd( aStentences, { oSentence:information( wdActiveEndAdjustedPageNumber      ) ;
                            , oSentence:information( wdVerticalPositionRelativeToPage   ) ;
                            , oSentence:information( wdHorizontalPositionRelativeToPage ) } )
         ?  oSentence:information( wdActiveEndAdjustedPageNumber      ), " "
         ?? oSentence:information( wdVerticalPositionRelativeToPage   ), " "
         ?? oSentence:information( wdHorizontalPositionRelativeToPage )
      endfor
      ?
      ? "Replace Shapes with text."
      ?
      for nShape := oDoc:Shapes:Count to 1 step - 1
         oShape := oDoc:Shapes( nShape )

         if oShape:Type == msoLinkedPicture .or. oShape:Type == msoPicture

            oShape:Select()
            for nSentence := 1 to len( aStentences )
               if aStentences[ nSentence, 1 ] == oWord:Selection:information( wdActiveEndAdjustedPageNumber      ) .and. ;
                  aStentences[ nSentence, 2 ] == oWord:Selection:information( wdVerticalPositionRelativeToPage   ) .and. ;
                  aStentences[ nSentence, 3 ] == oWord:Selection:information( wdHorizontalPositionRelativeToPage )
                  ?  oWord:Selection:information( wdActiveEndAdjustedPageNumber      ), " "
                  ?? oWord:Selection:information( wdVerticalPositionRelativeToPage   ), " "
                  ?? oWord:Selection:information( wdHorizontalPositionRelativeToPage )
                  oDoc:Sentences( nSentence ):Text := "*** Replaced Shape image number " + hb_ntos( nShape ) + " *** " + chr( 10 )
                  exit
               endif
            endfor
         endif
      endfor
   endif
   ?

   if oDoc:InlineShapes:Count > 0

      ? "Puts all the document sentences to an array for the InlineShapes."
      ?
      aStentences := {}
      for each oSentence in oDoc:Sentences
         aadd( aStentences, { oSentence:information( wdActiveEndAdjustedPageNumber      ) ;
                            , oSentence:information( wdVerticalPositionRelativeToPage   ) ;
                            , oSentence:information( wdHorizontalPositionRelativeToPage ) } )
         ?  oSentence:information( wdActiveEndAdjustedPageNumber      ), " "
         ?? oSentence:information( wdVerticalPositionRelativeToPage   ), " "
         ?? oSentence:information( wdHorizontalPositionRelativeToPage )
      endfor
      ?
      ? "Replace InlineShapes with text"
      ?
      for nShape := oDoc:InlineShapes:Count to 1 step - 1
         oShape := oDoc:InlineShapes( nShape )

         if oShape:Type == wdInlineShapePicture

            for nSentence := 1 to len( aStentences )
               if aStentences[ nSentence, 1 ] == oShape:Range:information( wdActiveEndAdjustedPageNumber      ) .and. ;
                  aStentences[ nSentence, 2 ] == oShape:Range:information( wdVerticalPositionRelativeToPage   ) .and. ;
                  aStentences[ nSentence, 3 ] == oShape:Range:information( wdHorizontalPositionRelativeToPage )
                  ?  oShape:Range:information( wdActiveEndAdjustedPageNumber ), " "
                  ?? oShape:Range:information( wdVerticalPositionRelativeToPage ), " "
                  ?? oShape:Range:information( wdHorizontalPositionRelativeToPage )
                  oDoc:Sentences( nSentence ):Text := "*** Replaced InlineShape image number " + hb_ntos( nShape ) + " *** " + chr( 10 )
                  exit
               endif
            endfor
         endif
      endfor
   endif

   oDoc:Save()
//   oDoc:Close( wdDoNotSaveChanges )

//   oWord:Quit()
   oWord := nil

   ?
   set( _SET_ALTERNATE, .F. )
   set( _SET_ALTFILE  , ""  )
   return

// End code.

[pete....@gmail.com]

Hello Bernard !

This thread is going to become an "MSO-API guide for dummies" ;-) about MS-Office API.

Really useful posts and certainly not only for the OP.

If your time permits, might you consider creating one (or a group of) source-code file(s), where to include

all these functions that you used into the samples you have posted so far, as well as, any other relevant MSO API functions

you might have? In other words, to create kind of a "contrib library". It would be a valuable set for the harbour users community.

This is just an idea and a kind suggestion, of course not a request or obligation.

regards,

Pete

[Bernard Mouille]

Hello Pete,

Thanks for your comment.

The source-code files exists here : Some codes with Harbour (free.fr)

Jayadev U speak like you at : https://groups.google.com/g/harbour-users/c/tOPZC5wuhXQ

I am retired and I put some codes that I have or search for my memory work !

Regards,

Bernard.

[Silvester Roklasfonoshio]

Thank you very much for your answer my dear brother ,just i have small question 

how i can get the location of shape in word document i just want the function which we use to get the location of the shape only the function my brother and the explanation of its parameter

also i want the function of writing in specific location in word document  only the function my dear brother no need for full program >>>ok dear see you

[Bernard Mouille]

Hello Silvester,

Go to  Some codes with Harbour (free.fr) and look the section    Microsoft Office Word