Attachment 154629 Details for Bug 127474 – Macro code to embed all images

Macro code to embed all images

code.txt (text/plain), 5.95 KB, created by Gerhard Weydt on 2019-09-29 00:23:22 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Gerhard Weydt

Created: 2019-09-29 00:23:22 UTC

Size: 5.95 KB

patch

obsolete

>'********************************************************************************
>'This library is Copyright (C) 2009 Bernard Marcelly
>
>'This library is free software; you can redistribute it and/or
>'modify it under the terms of the GNU Lesser General Public
>'License as published by the Free Software Foundation; either
>'version 2.1 of the License, or (at your option) any later version.
>
>'This library is distributed in the hope that it will be useful,
>'but WITHOUT ANY WARRANTY; without even the implied warranty of
>'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
>'Lesser General Public License for more details.
>'http://www.opensource.org/licenses/lgpl-license.php
>
>'You should have received a copy of the GNU Lesser General Public
>'License along with this library; if not, write to the Free Software
>'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
>'******************************************************************************
>
>'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
>'
>'	Adapted version, tested in 6.2 and 6.3, by Gerhard Weydt
>'	Obviously some changes in LibO happened, so the code didn't work any longer.
>'	Handling of graphics contained within groups has been added.
>'
>'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
>
>Option Explicit
>
>public arrType() as string
>public log as string
>
>
>Sub embedImagesOfThisDocument
>embedImagesOfDocument(ThisComponent)
>End Sub
>
>
>' this routine may be called from a macro working on several documents
>Sub embedImagesOfDocument(doc As Object)
>if doc.supportsService("com.sun.star.text.GenericTextDocument")  then
>  embedWriterImages(doc)
>elseif doc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") then
>  embedCalcImage(doc)
>elseif doc.SupportsService("com.sun.star.drawing.GenericDrawingDocument")  then
>  embedDrawImpressImage(doc)
>end if
>msgbox log
>End Sub
>
>' _______________________________________________________
>
>
>Sub embedWriterImages(doc As Object)
>Dim props(0) As New com.sun.star.beans.PropertyValue
>Dim gp As Object, imageURL As String
>Dim allImages As Object, image As Object, x As Long
>
>gp = createUnoservice("com.sun.star.graphic.GraphicProvider")
>props(0).Name = "URL"
>allImages = doc.GraphicObjects
>for x = 0 to allImages.Count -1
>  image = allImages(x)
>  imageURL = image.Graphic.OriginURL
>'	I don't know which was the reason for the following precondition when the programm was written,
>'	but the use of these "GraphicObject scheme URLs" is deprecated since 6.1.
>'	(Documentation for com.sun.star.graphic.MediaProperties)
>  if InStr(1, imageURL, "vnd.sun.star.GraphicObject:", 0) = 0  then
>    props(0).Value = imageURL
>    image.Graphic = gp.queryGraphic( props() )
>  end if
>next
>End Sub
>
>
>
>Sub embedCalcImage(doc As Object)
>Dim props(0) As New com.sun.star.beans.PropertyValue
>Dim gp As Object, imageURL As String
>Dim allPages As Object, aPage As Object, shapeX As Object
>Dim p As Long, x As Long
>
>arrType = array("com.sun.star.drawing.GroupShape", _
>				"com.sun.star.drawing.GraphicObjectShape", _
>				"com.sun.star.presentation.GraphicObjectShape")	'may be a copied shape
>gp = createUnoservice("com.sun.star.graphic.GraphicProvider")
>props(0).Name = "URL"
>allPages = doc.DrawPages ' one draw page per sheet
>for p = 0 to allPages.Count -1 ' scan each draw page
>  aPage = allPages(p)
>  for x = 0 to aPage.Count -1 ' scan all shapes in the draw page
>    shapeX = aPage(x)
>'	checkGroup(shapeX, arrType(), gp, props())
>	if checkGroup(shapeX, arrType(), gp, props()) then doc.setModified(TRUE)
>  next
>next
>End Sub
>
>
>
>
>Sub embedDrawImpressImage(doc As Object)
>Dim props(0) As New com.sun.star.beans.PropertyValue
>Dim gp As Object, imageURL As String
>Dim allPages As Object, aPage As Object, shapeX As Object
>Dim n As Long, p As Long, x As Long
>
>arrType = array("com.sun.star.drawing.GroupShape", _
>				"com.sun.star.drawing.GraphicObjectShape", _
>				"com.sun.star.presentation.GraphicObjectShape")
>gp = createUnoservice("com.sun.star.graphic.GraphicProvider")
>props(0).Name = "URL"
>allPages = doc.DrawPages ' one draw page per slide
>for n = 1 to 2 ' n=1 : DrawPages    n=2 : MasterPages
>  for p = 0 to allPages.Count -1
>    aPage = allPages(p)
>    for x = 0 to aPage.Count -1 ' scan all shapes in the page
>      shapeX = aPage(x)
>	  checkGroup(shapeX, arrType(), gp, props())
>    next
>  next
>  allPages = doc.MasterPages ' scan Master pages of the document
>next
>End Sub
>
>function checkGroup (shape as object, arrType(), gp as object, props() ) as boolean
>
>dim i as integer, ret as boolean
>Dim imageURL As String
>
>ret = FALSE
>if shape.ShapeType = arrType(0) then
>	shape.enterGroup
>	for i = 0 to shape.Count - 1
>		ret = checkGroup(shape.getByIndex(i), arrType(), gp, props())
>	next
>	shape.leaveGroup
>  else
>	for i = 1 to UBound(arrType) - 1
>		if shape.ShapeType = arrType(i) then
>	        if shape.Graphic.linked = TRUE then
>	          imageURL = shape.Graphic.OriginURL
>	          log = log & imageURL
>'				I don't know which was the reason for the following precondition when the programm was written,
>'				but the use of these "GraphicObject scheme URLs" is deprecated since 6.1.
>'				(Documentation for com.sun.star.graphic.MediaProperties)
>	          if InStr(1, imageURL, "vnd.sun.star.GraphicObject:", 0) = 0  then
>	            props(0).Value = imageURL
>	            if FileExists(imageURL) then
>	          	  shape.Graphic = gp.queryGraphic( props() )
>	          	  log = log & "  EMBEDDED" & CHR(10)
>	          	  ret = TRUE
>	             else
>	          	  msgbox "File " & imageURL & " for a linked graphic does not exist" & CHR(10) &_
>	          	  		"If file path is empty, then there has been an error, you have to find out " &_
>	          	  		"by yourself where the graphic is located."
>	            end if
>	          end if
>	        end if
>	        exit for
>		end if
>	next
>end if
>checkGroup = ret
>
>end function

Actions: View

Attachments on bug 127474: 154629 | 159690