makro - img - VYŘEŠENO

kamilos0123 · 14. 1. 2016 12:06:40

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)

neutr · 14. 1. 2016 13:37:51

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.

kamilos0123 · 14. 1. 2016 14:10:54

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.

lp. · 14. 1. 2016 14:20:38

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.

neutr · 15. 1. 2016 20:17:29

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)

kamilos0123 · 16. 1. 2016 13:01:53

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. :-)

neutr · 16. 1. 2016 14:01:43

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)

kamilos0123 · 19. 1. 2016 11:01:40

Funguje skvěle, moc děkuji!

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

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

makro - img - VYŘEŠENO

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

Re: makro - img - VYŘEŠENO

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

Re: makro - img - VYŘEŠENO

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

Re: makro - img - VYŘEŠENO

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

Re: makro - img - VYŘEŠENO

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

Re: makro - img - VYŘEŠENO

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

Re: makro - img - VYŘEŠENO

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

Re: makro - img - VYŘEŠENO

Zápatí