I installed extension Direct Colour Management (http://extensions.libreoffice.org/extension-center/dcm-direct-colour-management). This extension worked perfectly in earlier version (see https://www.openoffice.cz/navody/odstranovani-duplicit-export-obrazku-a-prime-michani-barev). But now, in last version, doesn't work on Linux Mint and Windows 10. After starting you can see error dialog screen and screen with BASIC code; there is: REM +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ REM Differentiation between LO and AOO is done via the variable product; so searching for this string will REM yield all occurrences of differences. REM +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ option explicit public dlg as object, langNr as string, ratioX as single, ratioY as single global copyPasteStore as long public dcmRunning as boolean ' +++++++++++++++++++++++++ check whether DCM is already running ++++++++++++++++++++++++ function checkRunning as boolean if dcmRunning then msgbox (langtext(langNr,50),16,langtext(langNr,15)) checkRunning = TRUE else dcmRunning = TRUE checkRunning = FALSE end if end function ' ==================== Start modules called from toolbars ================================ ' -------------------- Shapes -------------------------------- Sub DCMShape dim oDoc as object, oSel as object, selShapes as object dim drawpage as object dim i as integer, j as integer, colorType as string dim prop as object, csgFound as boolean oDoc = ThisComponent initLangtextEtc() 'initialise the texts table and other values if checkRunning then exit sub if isEmpty(oDoc.CurrentController.Selection) then msgbox (langtext(langNr,39),48,langtext(langNr,15)) 'please select some text exit sub end if oSel = oDoc.CurrentController.Selection 'this may be a (multiply) nested collection if isNull(oSel) then ' if a fontwork is contained in the visible selection, this selection is null. drawpage = oDoc.drawpage for i = 0 to drawpage.count - 1 csgFound = FALSE prop = drawpage.getByIndex(i).getPropertySetInfo.Properties for j = 0 to uBound(prop) if prop(j).Name = "CustomShapeGeometry" then csgFound = TRUE exit for end if next if csgFound then for j = 0 to uBound(drawpage.getByIndex(i).CustomShapeGeometry) if drawpage.getByIndex(i).CustomShapeGeometry(j).Name = "Type" then if left(drawpage.getByIndex(i).CustomShapeGeometry(j).Value,9) = "fontwork-" then msgbox (langtext(langNr,45),48,langtext(langNr,15)) exit sub end if end if next end if next msgbox (langtext(langNr,43),48,langtext(langNr,15)) exit sub end if if not (oSel.ImplementationName = "com.sun.star.drawing.SvxShapeCollection") or oSel.count = 0 then msgbox (langtext(langNr,39),48,langtext(langNr,15)) 'no shape object selected exit sub end if selShapes = createUnoService("com.sun.star.drawing.ShapeCollection") 'collection of selected shapes, for updating colorType = objShape (oSel, selShapes) select case colorType case "Fill" setShapeColor (selShapes, "FillColor") case "Line" setShapeColor (selShapes, "LineColor") case "Grad1" setShapeColor (selShapes, "FillGradient", "Start") case "Grad2" setShapeColor (selShapes, "FillGradient", "End") case "Hatch" setShapeColor (selShapes, "FillHatch") case "Shadow" setShapeColor (selShapes, "ShadowColor") end select 'dcmRunning = FALSE end sub ' -------------------- text: in a document, a frame -------------------------------- Sub DCMText dim oDoc as object, oSel as object, undo as object, enum as object, enum2 as object, elem as object, elem2 as object Dim elemColor as long dim origColor as long, newColor as long, origColorMult as string, colorType as string, selCount as long dim selstart as integer, i as integer, collapsed as boolean dim table as object, range as string, cells as object ' for text tables oDoc = ThisComponent undo = oDoc.UndoManager initLangtextEtc() 'initialise the texts table and other values if checkRunning then exit sub oSel = oDoc.CurrentSelection if isNull(oSel) then msgbox (langtext(langNr,41),48,langtext(langNr,15)) exit sub end if ' --------------------------- com.sun.star.text.TextRanges -------------------------------------- if oSel.supportsService("com.sun.star.text.TextRanges") then selCount = oSel.count if selCount = 1 and oSel.getByIndex(0).Text.createTextCursorByRange(oSel.getByIndex(0)).isCollapsed then collapsed = TRUE else collapsed = FALSE end if if selCount = 1 then 'one text range selected -> count = 1; more than one, say n -> count = n + 1, ' indexes starting with 1 contain the selected ranges selStart = 0 else selStart = 1 end if if NOT isEmpty(oSel(selStart).cell) then 'if the text is within a table, then the cell colour shall also be selectable colorType = objTableText(collapsed) else colorType = objText(collapsed) end if select case colorType case "none" exit sub case "BackColor" 'Cell back colour origColor = oSel(selStart).cell.BackColor ' get the colour of the first element for i = selStart + 1 to selCount - 1 ' start the loop with the second selection element if oSel(i).cell.BackColor <> origColor then origColorMult = "Y" exit for end if next case = "ParaBackColor", "CharBackColor", "CharColor" if isEmpty(oSel(selStart).getPropertyValue(colorType)) then origColorMult = "Y" origColor = RGB(255, 255, 255) else origColor = oSel(selStart).getPropertyValue(colorType) ' get the colour of the first element for i = selStart + 1 to selCount - 1 ' start the loop with the second selection element if isEmpty(oSel(i).getPropertyValue(colorType)) or oSel(i).getPropertyValue(colorType) <> origColor then origColorMult = "Y" exit for end if next end if case else ' should not happen msgbox "unsupported colorType " & colorType & " in program DCMStart . DCMText" exit sub end select HSVDialog (origColor, newColor, origColorMult) if newColor = -111 then exit sub undo.enterUndoContext(langtext(langNr,19)) 'group all changes into one undo action for i = selstart to selCount - 1 if colorType = "BackColor" then oSel(i).cell.BackColor = newColor else oSel(i).setPropertyValue(colorType, newColor) ' in LO this does not work for ParaBackColor since at least release 4.4.6 due to a bug ( # 99125). ' Selecting ParaBackColor is therefore deactivated for LO end if next undo.leaveUndoContext ' --------------------------- com.sun.star.text.TextTableCursor -------------------------------------- elseif oSel.supportsService("com.sun.star.text.TextTableCursor") then table = oDoc.currentController.ViewCursor.TextTable origColorMult = "N" colorType = objTableText(FALSE) if colorType = "none" then exit sub if colorType = "BackColor" then origColor = table.getCellByName(oSel.RangeName).getPropertyValue(colorType) range = oSel.RangeName if Instr(range, ":") = 0 then 'only one cell; in this case getCellRangeByName returns an error message cells = table.getCellByName(range) else cells = table.getCellRangeByName(range) end if if isEmpty(cells.BackColor) then origColorMult = "Y" else if isEmpty(oSel.getPropertyValue(colorType)) then 'if there are several colours used then the property is empty if colorType = "ParaBackColor" then origColor = table.getCellByName(oSel.RangeName).createEnumeration.nextElement.getPropertyValue(colorType) else origColor = table.getCellByName(oSel.RangeName).createEnumeration.nextElement.createEnumeration.nextElement.getPropertyValue(colorType) end if origColorMult = "Y" else origColor = oSel.getPropertyValue(colorType) end if end if HSVDialog (origColor, newColor, origColorMult) if newColor = -111 then exit sub if colorType = "BackColor" then cells.setPropertyValue(colorType, newColor) else oSel.setPropertyValue(colorType, newColor) end if else msgUnsupp(oSel) end if end sub ' -------------------- text object = text in a shape, in Draw, Impress -------------------------------- sub DCMTextObject dim oDoc as object, oSel as object, obj as object dim origColor as long, newColor as long, origColorMult as string dim enum as object, elem as object, enum2 as object, elem2 as object, s as string dim document as object, dispatcher as object, args1(0) as new com.sun.star.beans.PropertyValue dim selNormalisedStart as object, selNormalisedEnd as object oDoc = ThisComponent initLangtextEtc() 'initialise the texts table and other values if checkRunning then exit sub oSel = oDoc.CurrentSelection if oSel.supportsService("com.sun.star.text.TextCursor") then ' text in Draw, Impress ' if the text is selected from right to left, then the start is at the right end of the text. This yelds ' different esults when comparing starts/ends of elements with starts/ends of the selection. Therefore start ' and end are vertauscht in this case. if oSel.compareRegionStarts(oSel.getStart,oSel.getEnd) = 1 then ' selection from left to right selNormalisedStart = oSel.getStart selNormalisedEnd = oSel.getEnd else ' = -1, selectiom from right to left; case 0 is handled beforehand selNormalisedStart = oSel.getEnd selNormalisedEnd = oSel.getStart end if enum = oSel.text.createEnumeration ' to find out if there is more than one colour origColorMult = " " do while enum.hasMoreElements elem = enum.nextElement enum2 = elem.createEnumeration do while enum2.hasMoreElements elem2 = enum2.nextElement if origColorMult = "N" and oSel.compareRegionStarts(selNormalisedEnd,elem2) >= 0 then exit Do ' text element starts at or after end of selection -> rest of text not relevant for this part of selection if origColorMult = "N" and oSel.compareRegionStarts(elem2,selNormalisedEnd) = 1 and _ elem2.CharColor <> origColor then ' subsequent text element which contains part of selection and has different colour (there may be another ' reason for a new text element, e.g. another character weight) origColorMult = "Y" exit Do end if if origColorMult = " " and oSel.compareRegionStarts(selNormalisedStart,elem2.getEnd) = 1 then ' text element which contains start of selection origColor = elem2.CharColor origColorMult = "N" end if loop if origColorMult = "Y" then exit Do loop elseif oSel.supportsService("com.sun.star.drawing.ShapeCollection") then ' text in Writer; also possible is 'a combination of a table shape and another shape if oSel.count > 1 then 'e.g. combination of a table shape and another shape msgbox langtext(langNr,47),48,langtext(langNr,38) exit sub end if obj = oSel(0) if obj.supportsService("com.sun.star.drawing.Shape") then 'Cursor without extension in a shape msgbox langtext(langNr,41),48,langtext(langNr,38) exit sub elseif obj.supportsService("com.sun.star.presentation.Shape") then s = obj.ShapeType select case s case "com.sun.star.drawing.TableShape" tableShape(obj) exit sub case else msgUnsupp(obj) exit sub end select else end if else msgUnsupp(oSel) exit sub end if HSVDialog (origColor, newColor, origColorMult) if newColor >= -1 then ' oSel.CharColor = newColor does not create an entry in the undo stack ' We use the dispatcher instead: document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") args1(0).Name = "Color" args1(0).Value = newColor dispatcher.executeDispatch(document, ".uno:Color", "", 0, args1()) end if end sub ' -------------------- text in a shape in Writer or Calc -------------------------------- sub DCMShapeText dim oDoc as object, oSel as object, i as long, selStart as long dim origColor as long, newColor as long, origColorMult as string dim document as object, dispatcher as object, args1(0) as new com.sun.star.beans.PropertyValue dim enum as object, elem as object, enum2 as object, elem2 as object, elemColor as long oDoc = ThisComponent initLangtextEtc() 'initialise the texts table and other values if checkRunning then exit sub oSel = oDoc.CurrentSelection if oSel.supportsService("com.sun.star.drawing.ShapeCollection") then origColor = oSel.getByIndex(0).CharColor origColorMult = "N" origColor = -999999999 for i = 0 to oSel.count - 1 ' oSel.count > 1 can happen if one has selected the text of a shape and then selects another shape ' while pressing Ctrl. This is probably not meant to be a correct behaviour; it is only possible in Writer. ' Selecting the texts of more than one shape doesn't seem possible for the moment but the code will probably ' work correctly in this case. if NOT hasCharColor(oSel.getByIndex(i)) then msgbox langtext(langNr,47),48,langtext(langNr,38) exit sub end if enum = oSel(i).createEnumeration do while enum.hasMoreElements elem = enum.nextElement enum2 = elem.createEnumeration do while enum2.hasMoreElements elem2 = enum2.nextElement elemColor = elem2.CharColor if elemColor <> origColor then if origColor = -999999999 then 'initial value origcolor = elemColor else ' In this case the selection supplies only the shape with its entire text; ' the view cursor has an empty text. So we cannot recognize the colour of ' the selected text if there is more than one colour present. origColorMult = " " origcolor = RGB(255, 255, 255) exit do end if end if loop loop next else msgUnsupp(oSel) exit sub end if HSVDialog (origColor, newColor, origColorMult) if newColor >= -1 then ' In this case the selection supplies only the shape with its entire text; the view cursor has an empty text. ' Therefore the only way was to use the dispatcher: document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") args1(0).Name = "Color" args1(0).Value = newColor dispatcher.executeDispatch(document, ".uno:Color", "", 0, args1()) end if end sub ' -------------- text frame ----------------------- sub DCMFrame dim oDoc as object, oSel as object dim origColor as long, newColor as long, origColorMult as string dim dlgLib as object, dlgFrame as object dim ctrl as object dim imageFolder as string dim choice as integer dim stru as variant oDoc = ThisComponent initLangtextEtc() 'initialise the texts table and other values if checkRunning then exit sub oSel = oDoc.CurrentController.Selection if isNull(oSel) then msgbox (langtext(langNr,41),48,langtext(langNr,15)) exit sub end if DialogLibraries.LoadLibrary("DirectColourManager") dlgLib = DialogLibraries.GetByName("DirectColourManager") dlgFrame = createUnoDialog(dlgLib.getByName("DlgFrame") imageFolder = getimageFolder() dlgFrame.Title = langtext(langNr,20) ctrl = dlgFrame.getControl("bBack") ctrl.label = " " & langtext(langNr,27) ctrl.model.ImageURL = imageFolder & "DCMParBack.png" ctrl = dlgFrame.getControl("bBorder") ctrl.label = " " & langtext(langNr,25) ctrl.model.ImageURL = imageFolder & "DCMLineColor.png" ctrl = dlgFrame.getControl("bShadow") ctrl.label = " " & langtext(langNr,26) ctrl.model.ImageURL = imageFolder & "DCMShadowColor.png" ctrl = dlgFrame.getControl("bKO").model ctrl.label = " " & langtext(langNr,13) ctrl.ImageURL = imageFolder & "SignKO.png" choice = dlgFrame.execute select case choice case 0 'button KO exit sub ' return codes from sub ColorPropSel case 1041 origColor = oSel.BackColor case 1042 origColor = oSel.LeftBorder.Color case 1043 origColor = oSel.ShadowFormat.Color case else ' cannot happen exit sub end select origColorMult = "N" HSVDialog (origColor, newColor, origColorMult) if newColor >= -1 then if oDoc.wasModifiedSinceLastSave then if msgbox (langtext(langNr,40), 4 + 32, langtext(langNr,38)) = 6 then oDoc.store 'com.sun.star.awt.MessageBoxResults.YES ( = 1 ) is N O T the right value!!! end if select case choice ' return codes from sub ColorPropSel case 1041 oSel.setPropertyValue("BackColor", newColor) case 1042 stru = oSel.TopBorder stru.Color = newColor oSel.TopBorder = stru stru = oSel.BottomBorder stru.Color = newColor oSel.BottomBorder = stru stru = oSel.LeftBorder stru.Color = newColor oSel.LeftBorder = stru stru = oSel.RightBorder stru.Color = newColor oSel.RightBorder = stru case 1043 stru = oSel.ShadowFormat stru.Color = newColor if stru.location = 0 then stru.location = 4 ' no shadow --> to the right and below oSel.ShadowFormat = stru end select end if end sub ' ---------------------- cell or cell range in Calc ----------------------------- sub DCMCell dim oDoc as object, oSel as object, undo as object dim origColor as long, newColor as long, origColorMult as string, colorType as string dim i as long, selUpper as long, s as string dim enum as object, elem as object, enum2 as object, elem2 as object oDoc = ThisComponent initLangtextEtc() 'initialise the texts table and other values if checkRunning then exit sub oSel = oDoc.currentSelection ' if there are two paragraphs or text portions with different colours, then setting CharColor ' changes only the first text portion. Therefore the option for CharColor is disabled in this case. colorType = objCell if colorType = "none" then exit sub origColorMult = " " if oSel.supportsService("com.sun.star.sheet.SheetCellRanges") then ' mind the plural !! for i = 0 to oSel.Count - 1 analyseCellSel(oSel(i), colorType, origColor, origColorMult) if origColorMult = "Y" then exit for next elseif oSel.supportsService("com.sun.star.sheet.SheetCellRange") _ or oSel.supportsService("com.sun.star.sheet.SheetCell") then analyseCellSel(oSel, colorType, origColor, origColorMult) else msgUnsupp(oSel) end if HSVDialog (origColor, newColor, origColorMult) if newColor = -111 then exit sub if colortype = "CharColor" then if oSel.supportsService("com.sun.star.sheet.SheetCellRanges") then ' mind the plural !! selUpper = oSel.count - 1 ' count exists only in this case else selUpper = 0 end if undo = oDoc.UndoManager undo.enterUndoContext(langtext(langNr,19)) 'group all changes into one undo action for i = 0 to selUpper if oSel(i).supportsService("com.sun.star.sheet.SheetCell") then 'single cell DCMCellset (oSel(i).createEnumeration, newColor) else 'rectangle of selected cells DCMCellset(oSel(i).CellFormatRanges.createEnumeration, newColor) end if next oSel.setPropertyValue(colorType, newColor) undo.leaveUndoContext else oSel.setPropertyValue(colorType, newColor) end if end sub sub DCMCellSet (enum as object, newColor as long) dim elem as object, enum2 as object, elem2 as object, enum3 as object, elem3 as object, s as string do while enum.hasMoreElements elem = enum.nextElement s = elem.dbg_methods if Instr(s,"createEnumeration") > 0 then 'then there's another enumeration level enum2 = elem.createEnumeration do while enum2.hasMoreElements elem2 = enum2.nextElement s = elem2.dbg_methods if Instr(s,"createEnumeration") > 0 then 'then there's another enumeration level enum3 = elem2.createEnumeration do while enum3.hasMoreElements elem3 = enum3.nextElement elem3.CharColor = newColor loop else elem2.CharColor = newColor end if loop else elem.CharColor = newColor end if loop end sub ' ============================ start modules called from menus =============================================== ' It is not possible to enter dedicated menu items for the different object types, in all cases. There is ' therefore only one menu item, and the dedicated modules are called from there. ' ------------------------- called from menu "Format" in Writer ------------------------------------------ sub menuWriter dim oDoc as object, oSel as object oDoc = ThisComponent oSel = oDoc.CurrentController.Selection if oSel.supportsService("com.sun.star.text.TextRanges") then ' if nothing is selected, then the selection is a collapsed string. In the context of this module it is not clear ' which objects shall be selected, so there has to be a message different from the one supplied by the same ' question in DCMText if oSel.Count = 1 and oSel.getByIndex(0).Text.createTextCursorByRange(oSel.getByIndex(0)).isCollapsed then initLangtextEtc() 'initialise the texts table and other values msgbox langtext(langNr,42),48,langtext(langNr,38) exit sub end if DCMText() elseif oSel.supportsService("com.sun.star.text.TextTableCursor")then DCMText() elseif oSel.supportsService("com.sun.star.text.TextFrame") then DCMFrame() elseif oSel.supportsService("com.sun.star.drawing.ShapeCollection") then callDlgMenuShape exit sub else initLangtextEtc() 'initialise the texts table and other values msgUnsupp(oSel) end if end sub sub callDlgMenuShape dim dlgLib as object, dlgMenuShape as object, ctrl as object initLangtextEtc() 'initialise the texts table and other values if checkRunning then exit sub DialogLibraries.LoadLibrary("DirectColourManager") dlgLib = DialogLibraries.GetByName("DirectColourManager") dlgMenuShape = createUnoDialog(dlgLib.getByName("DlgMenuShape") dlgMenuShape.Title = langtext(langNr,35) dlgMenuShape.getControl("bShape").label = langtext(langNr,36) dlgMenuShape.getControl("bText").model.label = langtext(langNr,37) ctrl = dlgMenuShape.getControl("bKO").model ctrl.label = " " & langtext(langNr,13) ctrl.ImageURL = imageFolder & "SignKO.png" dlgMenuShape.execute ' buttons bShape and bText are handled in the subs below dlgMenuShape.dispose end sub sub menuShapeShape (evt as object) DCMShape() evt.source.context.endExecute() end sub sub menuShapeText (evt as object) DCMShapeText() evt.source.context.endExecute() end sub ' ------------------------- called from menu "Format" in Draw & Impress ------------------------------------ sub menuDraw dim oDoc as object, oSel as object oDoc = ThisComponent oSel = oDoc.CurrentController.Selection if oSel.supportsService ("com.sun.star.text.TextCursor") then DCMTextObject() else DCMShape() endif end sub ' ------------------------- called from menu "Format" in Calc ------------------------------------ sub menuCalc dim oDoc as object, oSel as object oDoc = ThisComponent oSel = oDoc.CurrentController.Selection if oSel.supportsService ("com.sun.star.drawing.ShapeCollection") then callDlgMenuShape() else DCMCell() endif end sub ' =================== auxiliary modules ==================================== ' ------------- analyse colours used in cells ---------------------- sub analyseCellSel (obj as object, colorType as string, origColor as long, origColorMult as string) dim cellFormat as object, i as integer cellFormat = obj.getCellFormatRanges if origColorMult = " " then origColorMult = "N" origColor = cellFormat(0).getPropertyValue(colorType) end if for i = 0 to cellFormat.Count - 1 if cellFormat(i).getPropertyValue(colorType) <> origColor then origColorMult = "Y" exit for end if next end sub ' ---------------------- set shape color ------------------------------- sub setShapeColor (selShapes as object, colorType as string, optional subType as string) dim oDoc as object dim prop as variant, selShape as object, prop2 as variant, prop3 as variant dim origColor as long, newColor as long, origColorMult as string dim i as integer oDoc = ThisComponent origColorMult = " " for i = 0 to selShapes.count - 1 if origColorMult = "Y" then exit for selShape = selShapes.getByIndex(i) prop = selShape.GetPropertyValue(colorType) if selShape.supportsService("com.sun.star.drawing.RectangleShape") or _ selShape.supportsService("com.sun.star.drawing.EllipseShape") or _ selShape.supportsService("com.sun.star.drawing.OLE2Shape") or _ selShape.supportsService("com.sun.star.drawing.TextShape") or _ selShape.supportsService("com.sun.star.drawing.CustomShape") then if origColorMult = " " then origColorMult = "N" select case colorType case "FillGradient" if subType = "Start" then origColor = prop.StartColor elseif subType = "End" then origColor = prop.EndColor end if case "FillHatch" origColor = prop.Color case else origColor = prop end select else select case colorType case "FillGradient" if subType = "Start" and origColor <> prop.StartColor then origColorMult = "Y" elseif subType = "End" and origColor <> prop.EndColor then origColorMult = "Y" end if case "FillHatch" if origColor <> prop.Color then origColorMult = "Y" case else if origColor <> prop then origColorMult = "Y" end select end if else if origColorMult = " " then origColorMult = "N" origColor = prop else if origColor <> prop then origColorMult = "Y" end if end if next HSVDialog (origColor, newColor, origColorMult) if newColor >= -1 then if oDoc.wasModifiedSinceLastSave then if msgbox (langtext(langNr,40), 4 + 32, langtext(langNr,38)) = 6 then oDoc.store 'com.sun.star.awt.MessageBoxResults.YES is N O T the right value!!! end if for i = 0 to selShapes.count - 1 selShape = selShapes.getByIndex(i) prop2 = selShape.GetPropertyValue(colorType) if selShape.supportsService("com.sun.star.drawing.RectangleShape") or _ selShape.supportsService("com.sun.star.drawing.EllipseShape") or _ selShape.supportsService("com.sun.star.drawing.OLE2Shape") or _ selShape.supportsService("com.sun.star.drawing.TextShape") or _ selShape.supportsService("com.sun.star.drawing.CustomShape") then select case colorType case "FillGradient" if subType = "Start" then prop2.StartColor = newColor elseif subType = "End" then prop2.EndColor = newColor end if prop3 = prop2 selShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT case "FillHatch" prop2.Color = newColor prop3 = prop2 selShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH case "FillColor" prop3 = newColor selShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID case "ShadowColor" selShape.Shadow = TRUE prop3 = newColor case "LineColor" prop3 = newColor selShape.LineStyle = com.sun.star.drawing.LineStyle.SOLID case else prop3 = newColor end select else prop3 = newColor end if selShape.setPropertyValue(colorType, prop3) next selShapes.dispose oDoc.setModified(TRUE) end if end sub ' ------------------------ table shape (in Impress, Draw) ----------------------------------------------- ' The selection returns the entire shape, so there was no way to format one or several cells, this has to be done ' using the standard tools. The actions below change the table template, i.e. all table shapes in the document sub tableShape (obj as object) dim dlglib as object, dlgTS as object, elemt as string, templ as object dim origColor as long, newColor as long, origColorMult as string dim imageFolder as string, ctrl as object if not ( obj.UseFirstRowStyle and obj.UseBandingRowStyle) then msgbox langtext(langNr,44),48,langtext(langNr,38) exit sub end if templ = obj.tableTemplate if not ( templ.hasByName("first-row") and templ.hasByName("odd-rows") and templ.hasByName("body") ) then msgbox langtext(langNr,44),48,langtext(langNr,38) exit sub end if if isNull (templ.getByName("first-row")) or isNull (templ.getByName("odd-rows")) or isNull (templ.getByName("body")) then msgbox langtext(langNr,52),48,langtext(langNr,38) exit sub end if DialogLibraries.LoadLibrary("DirectColourManager") dlgLib = DialogLibraries.GetByName("DirectColourManager") dlgTS = createUnoDialog(dlgLib.getByName("DlgTableShape") imageFolder = getimageFolder() dlgTS.Title = langtext(langNr,20) dlgTS.getControl("info").text = langtext(langNr,46) ctrl = dlgTS.getControl("bFirstRow") ctrl.label = " " & langtext(langNr,32) ctrl.model.ImageURL = imageFolder & "DCMTableFirstColor.png" ctrl = dlgTS.getControl("bOddRows") ctrl.label = " " & langtext(langNr,33) ctrl.model.ImageURL = imageFolder & "DCMTableOddColor.png" ctrl = dlgTS.getControl("bEvenRows") ctrl.label = " " & langtext(langNr,34) ctrl.model.ImageURL = imageFolder & "DCMTableEvenColor.png" ctrl = dlgTS.getControl("bKO").model ctrl.label = " " & langtext(langNr,13) ctrl.ImageURL = imageFolder & "SignKO.png" select case dlgTS.execute case 0 'button KO exit sub ' return codes from sub ColorPropSel case 1031 elemt = "first-row" case 1032 elemt = "odd-rows" case 1033 elemt = "body" case else ' cannot happen exit sub end select origColor = templ.getByName(elemt).FillColor origColorMult = "N" HSVDialog (origColor, newColor, origColorMult) if newColor = -111 then exit sub if ThisComponent.wasModifiedSinceLastSave then if msgbox (langtext(langNr,40), 4 + 32, langtext(langNr,38)) = 6 then ThisComponent.store 'com.sun.star.awt.MessageBoxResults.YES is N O T the right value!!! end if templ.getByName(elemt).FillColor = newColor end sub
it seems like a duplicate of bug 106529. Closing as RESOLVED DUPLICATED. Thanks for reporting. *** This bug has been marked as a duplicate of bug 106529 ***
You may want to notify the author (gerhard.weydt@t-online.de) about that.
I have added a new release 1.1.3 to DCM on the extensions site. It worked fine on release 5.3.1.2 of LibO. It is not yet displayed as the current release, and I am waiting for someone to help with this issue, but you will find it at the bottom of the list of releases whence you can download it.
(In reply to Gerhard Weydt from comment #3) > I have added a new release 1.1.3 to DCM on the extensions site. It worked > fine on release 5.3.1.2 of LibO. Thank you! That's great news. > It is not yet displayed as the current release, and I am waiting for someone > to help with this issue, but you will find it at the bottom of the list of > releases whence you can download it. I suppose you should file a bug report about it here; please CC Andreas Mantke who is the expert in the Extensions site infrastructure (I CC him also to this bug).
I see that TextMath (https://extensions.libreoffice.org/extensions/texmaths-1) managed to make their fix (released a day ago to address the same issue) to be current.
The problem of the new version not being visible as latest reffered to in comment 3 has been solved. So this bug can be regarded as finally closed. Gerhard