OpenOffice.cz - web věnovaný kancelářským balíkům OpenOffice.org

ludviktrnka

Člen

Registrace: 9. 7. 2009

Příspěvků: 711

smazat obrázek makrem - vyřešeno

Dobrý den, lze nějak spolehlivě smazat obrázek makrem? Používám makro na mazání obsahu buněk a to bohužel někdy funguje a někdy ne (nepřišel jsem na souvislosti kdy funguje a kdy nikoli)

mazani = oList.getCellRangeByName("H4:P20")
  with com.sun.star.sheet.CellFlags
    mazani.ClearContents(.OBJECTS)
  end with

V diskuzi k excelu jsem našel takovýto příkaz ActiveSheet.Pictures("Picture 3").Delete respektive ActiveSheet.Pictures(1).Delete

existuje něco takového pro Basic?

Ještě bych měl asi doplnit že ten obrázek se do dokumentu dostal níže uvedeným makrem. A tím že je to vlastně jen odkaz na internet tak vlastně ani není součástí dokumentu a nemá tedy žádné jméno (neobjevuje se v "navigátoru"). Poradíte prosím?

Sub vlozqr
 
  Dim oDesktop As Object, oDoc As Object, oList as object, mazani as object
  Dim mNoArgs()
  Dim sGraphicURL As String
  Dim sGraphicService As String, sUrl As String
  Dim oDrawPages As Object, oDrawPage As Object
  Dim oGraphic As Object
  oDoc = ThisComponent
	oList = oDoc.Sheets.GetByName("faktura_automat")
    
  mazani = oList.getCellRangeByName("H4:P20")
  with com.sun.star.sheet.CellFlags
    mazani.ClearContents(.OBJECTS)
  end with
  
  wait 1000
  
  text_kodu = oList.GetCellRangeByName("X36").String
    
  sGraphicURL = convertToURL("http://chart.apis.google.com/chart?cht=qr&chs=150x150&chl=" & text_kodu & "&chld=M|0")
  sGraphicService = "com.sun.star.drawing.GraphicObjectShape"
  oDrawPage = oList.getDrawPage()
  oGraphic = ThisComponent.createInstance(sGraphicService)
  oGraphic.GraphicURL = sGraphicURL
  oDrawPage.add(oGraphic)
  
  REM Size the object
  Dim TheSize As New com.sun.star.awt.Size
  TheSize.width=4100
  TheSize.height=4100
  oGraphic.setsize(TheSize)

  REM Position the object
  Dim aPosition As New com.sun.star.awt.Point
  aPosition.X = 16800
  aPosition.Y = 3080
  oGraphic.setposition(aPosition)
  
 
'  msg = msgbox ("Chceš to hned smazat?",1,"smazat/konec")
'  if msg <> 1 Then
' 	 exit sub
'  	else     
'  	 mazani = oList.getCellRangeByName("L6:N16")
'  	 with com.sun.star.sheet.CellFlags
'		mazani.ClearContents(.OBJECTS)
'  	 end with
'  end if		

End Sub

Editoval ludviktrnka (30. 12. 2014 21:10:18)

---

LibreOffice 5.4.

neutr

Člen

Registrace: 8. 3. 2007

Příspěvků: 3,468

Re: smazat obrázek makrem - vyřešeno

Tohle makro by mělo smazat všechny objekty (obrázky, nebo ovládací prvky) vždy. problém je právě asi s tím, že objekt musí být ukotven uvnitř definované array (H4:P20).
     Objekty mohou být kotveny také ke stránce - a pak toto makro fungovat nemůže. S obrázky bývá problém. Potřebují "DrawPage". Když mají DrawPage - pracujeme - (mažeme, přesouváme aj) drawPage. Mám dojem, že je to svázání s databází (podobně obrázková tlačítka). Při tom DrawPage pro obecný obrázek není podmíněna.
     Někde jsem tuto problematiku měl jako příklad, ale později jsem ho nenašel. Mám dojem, že to bylo řešení pomocí cursoru a select. Bylo něco, nebo snad toto myslím mezi Dennyho Brewera knhovnami maker.

     Pokud si pamatuji, tak obrázky šly mazat nahraným makrem. Bohu žel nefungovalo to na příklad, když byl obrázek na pozadí. Obrázek musel mít jméno a ke spuštění se muselo makro upravit.
     Když budete nahrávat makro k mazání - tak vyberte vše a nezapomeňte zaškrtnout objekty. To se mi osvědčilo nejlépe bez velkého laborování. Bohu žel v LO nejnovější verze nahraná makra selhávají. Takže otestujte (vytvořte) raději v AOO a pak v LO :-(
     Kdysi jsem řešil mazání obrázků zkopírovaných z internetu a na to mám makro, i když je to asi podobné, jako uvádíte. Když budete chtít - pošlu Vám ho.

---

Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

ludviktrnka

Člen

Registrace: 9. 7. 2009

Příspěvků: 711

Re: smazat obrázek makrem - vyřešeno

Mám zájem o cokoli. Nahrané makro se chová stejně jako to zapsané, není spolehlivé, většinou smaže ale někdy z nepochopitelného důvodu ne.

---

LibreOffice 5.4.

neutr

Člen

Registrace: 8. 3. 2007

Příspěvků: 3,468

Re: smazat obrázek makrem - vyřešeno

Právě musíte prozkoumat jaké má ten mazaný obrázek vlastnosti. Měly by tam být ještě definované asi "property" a podobně. Pokud je obrázek ukotvený ke stránce, měl by se "překotvit" k buňce.
     Já používám úpravu následujícího makra. Je to mazání buňky podle typu obsahu z nichž je jeden také "obrázek".

Sub DeleteUsedCells 'Smaže souvislé neprázdné buňky sloupec "A" od A1 - Původní název FindUsedCells - viz poznámky
Sheet = ThisComponent.Sheets.getByName("List1")
ColA = Sheet.Columns.getByName("A") 'Get the Column named A
UsedCells = ColA.queryContentCells(23)  'Find the cells with content
REM queryContentCells() looks for cells with certain kinds of content. Pure Values = 1, DateTime = 2, 
REM String = 4, Annotation = 8, Formula = 16. See http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/CellFlags.html
REM I chose to search for Values, DateTimes, Strings and Formulas. The search value is then 1 + 2 + 4 + 16 = 23
FirstUsedRange = UsedCells.getByIndex(0)  'Get the first range of used cells
FirstUsedRange.clearContents(23)
'VALUE = 1 ->selects constant numeric values that are not formatted as dates or times.
'DATETIME = 2 ->selects constant numeric values that have a date or time number format.
'STRING = 4 ->selects constant strings.
'ANNOTATION = 8 ->selects cell annotations.
'FORMULA = 16 ->selects formulas.
'HARDATTR = 32 ->selects all explicit formatting, but not the formatting which is applied implicitly through style sheets.
'STYLES = 64 ->selects cell styles.
'OBJECTS = 128 ->selects drawing objects.
'EDITATTR = 256 ->selects formatting within parts of the cell contents.
'FORMATTED = 512 ->selects cells with formatting within the cells or cells with more than one paragraph within the cells.
End Sub

---

Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

ludviktrnka

Člen

Registrace: 9. 7. 2009

Příspěvků: 711

Re: smazat obrázek makrem - vyřešeno

Dobrý den, váš kód jsem zkoušel, ale nějak jsem jej nedokázal použít na svůj případ. Obrázek nebyl nalezen takže na řádku FirstUsedRange = UsedCells.getByIndex(0) se objeví chyba v běhu. A ošetřit pro případ nenalezení obrázku by asi bylo možné, ale to není řešení. Zkrátka obrázek to nenalezne a nemaže. Zkoušel jsem pořádně projet to mazání pomocí makra uvedeného na začátku a nemaže cca každý desátý obrázek. Vzhledem k tomu že se obrázky přesně překrývají, tak to zas až tak nevadí, ale je to prostě krapet otrava. Jak mám obrázek makrem kotvit k buňce? A nepohne se po "překotvení"?

---

LibreOffice 5.4.

ludviktrnka

Člen

Registrace: 9. 7. 2009

Příspěvků: 711

Re: smazat obrázek makrem - vyřešeno

tak jsem to konečně našel (nejsem programator jen hledač hotových kódů:). Obrázky co chci zachovat si pojmenuji, ovládací prvky jsou též ošetřené, takže to funguje suprově.

Sub Clean
   oSheet = ThisComponent.Sheets.getByName("List1")
   oDP = oSheet.DrawPage
   for i = oDP.Count - 1 to 0 step -1
      oObj = oDP.getByIndex(i)
      TextString = oObj.getname
      If TextString <> "logo" Then
         If TextString <> "kategorie" Then
           If Not oObj.supportsService("com.sun.star.drawing.ControlShape") Then 
                         'this prevents db Control buttons from being deleted
              oDP.remove(oObj)
           End If
         End If  
      End If
   next i
End sub

---

LibreOffice 5.4.