Fórum pro uživatele kancelářského balíku OpenOffice | LibreOffice
 

#1 14. 1. 2016 12:06:40

kamilos0123
Člen
Registrace: 14. 1. 2016
Příspěvků: 23

makro - img - VYŘEŠENO

Zdravím,
potřeboval bych poradit, mám v tabulce v jednom sloupci URL obrázků a potřeboval bych do druhého sloupce ten obrázek dle URL v daném řádku.
Nikdy jsem s makrem nepracoval, našel jsme na netu tohle makro, jste schopni mi prosím poradit kde je problém nebo jak ho upravit aby fungovalo? háže mi to chybu RANGE (což je asi nějaký rozsah...)

Sub InsImg()

Dim URL As Range

For Each URL In Range("A1", Cells(Rows.Count, "A").End(xlUp))
With URL.Parent.Pictures.Insert(URL.Value)
.Left = URL.Offset(0, 1).Left
.Top = URL.Offset(0, 1).Top
URL.EntireRow.RowHeight = .Height
End With
Next

End Sub

Děkuji za odpověď.
---------------
EDIT: údajně to je makro pro Excel, jste schopni mi prosím poradit, jak na to, aby to fungovalo? kde je potřeba co změnit? Děkuji.

Editoval kamilos0123 (19. 1. 2016 11:03:22)


LibreOffice

Offline

#2 14. 1. 2016 13:37:51

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 2,581

Re: makro - img - VYŘEŠENO

URL je adresa kde je ten obrázek. Vy máte navadenu buňku A1 kde ovšem není URL ale hypertextový odkaz. Otevřete si tu klikačku a adresu zkopírujte. Jde tam o to jakou klikačku tam máte jsou dva druhy : jeden z "Vložit" a druhý typ může být vzerec.
    Následně byste měl deklarovat
DIM sVar as string
sVar = ten řetězec URL (A1)
    problém je v tom tvaru řetězce. Pokud je řetězec ve správném tvaru tak by to mělo jít načíst bez problému. Ale řetězec bývá často v nestravitelném tvaru a pak se musí dát tvar
sVar = ConvertToUrl(ten řetězec URL).
-------------------------------------------
    Z toho důvodu nejprve do A1 vlastní tvar URL (například http://xyz/abc/obrázej.jpg). V jiném případě to musíte makrem přežvýkat na ConvertToUrl. Lze to udělat i bez makra :
- Dáte vytvořit hyperlinkový odkaz z nabídky VLOŽIT - někde mimo. Vytvoříte hyperlink a ten znovu otevřete. V prvním řádku je to už převedeno na správný tvar. Ten potom dáte do A1.
    Pokud se Vám nezadaří, během zítřka budu doma a udělám Vám komplet makro.


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

Offline

#3 14. 1. 2016 14:10:54

kamilos0123
Člen
Registrace: 14. 1. 2016
Příspěvků: 23

Re: makro - img - VYŘEŠENO

To budete hodný, do zítra počkám, jsem totiž z toho vedle. Ještě přikládám obrázek pro ujištění, že si rozumíme. http://s14.postimg.org/bm82eqmls/makro.jpg
Předem děkuji.


LibreOffice

Offline

#4 14. 1. 2016 14:20:38

lp.
Člen
Registrace: 24. 9. 2009
Příspěvků: 771

Re: makro - img - VYŘEŠENO

Makro je z excelu. Můžete ponechat řádky Sub InsImg()  a End Sub. Ostatní je třeba změnit.

Prochází sloupec A, z buňky vezme jméno/adresu obrázku, levý horní roh vloženého obrázku připojí na levý horní roh buňky napravo (sloupec B) a nastaví výšku řádku podle výšky obrázku.

Offline

#5 15. 1. 2016 20:17:29

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 2,581

Re: makro - img - VYŘEŠENO

Není to nic světoborného. Dáte kurzor přímo na hyperlink a spustíte makro. To si načte adesu obrázku a pak ho vlepí do buňky vedle vpravo tak jak máte na obrázku, ale neumí přizpůsobit buňku.
     To je složitější - musí se načíst nejprve "Properties obrázku", to potom zkorigovat aby to nebyl plakát, nebo blecha a nakonec by se měly přizpůsobit rozměry buňky aby obrázek byl v určité buňce.
     Zase klikačka může být kdekoliv a zůstane funkční i po vložení obrázku. Je možné odkrokovat dál (jinam), nebo to udělat jako iteraci všech neprázdných buněk. Ale buňky musíte upravovat na správný rozměr ručně.

Sub VlozObrazek
Dim EC, ER, RS as integer
Dim sVar as string
oCell = ThisComponent.CurrentController.getSelection() 
With oCell.RangeAddress 
SH = .Sheet 
SC = .StartColumn 
SR = .StartRow
End With 
EC = SC
ER = SR
oSheet = ThisComponent.Sheets(SH) 
oCell = oSheet.GetCellbyPosition(SC, SR)
sVar = oCell.string
KrokDoPrava(sVar)
End Sub

sub KrokDoPrava(ByVal sVar as string)
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = false
dim args2(1) as new com.sun.star.beans.PropertyValue
args2(0).Name = "FileName"
' načtení obrázku z internetu přímý zápis adresy
'args2(0).Value = "http://chart.apis.google.com/chart?cht=qr&chs=200x200&chl="
args2(0).Value = sVar
args2(1).Name = "AsLink"
args2(1).Value = false
dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args1())
dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args2())
end sub

Editoval neutr (15. 1. 2016 20:19:36)


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

Offline

#6 16. 1. 2016 13:01:53

kamilos0123
Člen
Registrace: 14. 1. 2016
Příspěvků: 23

Re: makro - img - VYŘEŠENO

Super makro funguje skoro tak jak jsem chtěl, ale kdybych chtěl, aby se mi načetly všechny obrázky ve sloupci (momentálně se mi načte pouze z prvního řádku) tak to udělám jak prosím? Děkuji za odpověď a ochotu. :-)


LibreOffice

Offline

#7 16. 1. 2016 14:01:43

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 2,581

Re: makro - img - VYŘEŠENO

Mělo by stačit tohle :

Sub VlozObrazek
Dim SC, EC, SR, ER as long
Dim sVar, sVal as string
oCell = ThisComponent.CurrentController.getSelection() 
With oCell.RangeAddress 
SH = .Sheet 
SC = .StartColumn 
SR = .StartRow
ER = .EndRow
End With 
EC = SC

oSheet = ThisComponent.Sheets(SH) 
For i = SR To ER
sVar = ""
oCell = oSheet.GetCellbyPosition(SC, i)
sVar = oCell.string
IF sVar = "" Then
GoTo dalsi
End If
sVal = oSheet.getcolumns().ElementNames(SC) & i+1
print sVal
KrokDoPrava(sVar, sVal)
dalsi:
Next i
End Sub

sub KrokDoPrava(ByVal sVar as string, ByVal sVal as string)
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = sVal
dim args2(1) as new com.sun.star.beans.PropertyValue
args2(0).Name = "By"
args2(0).Value = 1
args2(1).Name = "Sel"
args2(1).Value = false
dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = "FileName"
' načtení obrázku z internetu přímý zápis adresy
'args3(0).Value = "http://chart.apis.google.com/chart?cht=qr&chs=200x200&chl="
args3(0).Value = sVar
args3(1).Name = "AsLink"
args3(1).Value = false
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args2())
dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args3())
end sub

     Vyberete sloupec (musí být "vymodřený") a spustíte makro. Píšu to z hlavy tak když by to nechodilo napište. Přibližně za dve hodky budu doma a popřípadě to otestuju a opravím ):-).

Editoval neutr (16. 1. 2016 14:38:13)


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

Offline

#8 19. 1. 2016 11:01:40

kamilos0123
Člen
Registrace: 14. 1. 2016
Příspěvků: 23

Re: makro - img - VYŘEŠENO

Funguje skvěle, moc děkuji!


LibreOffice

Offline

Zápatí