< návrat zpět
MS Excel
Téma: Jak vložit obrázek, aby byl součástí XLS souboru 
Zaslal/a CmeldaBoris 19.8.2015 13:46
EXCEL 2013:
Nevíte někdo, jak makrem vložit obrázek na list (z disku) tak, aby tento obrázek byl součástí XLS, tedy zůstal na listu i po odstranění obrázku ze zdrojového umístění?
Když zaznamenám makro pro různé způsoby vložení (Vložit, Připojit k souboru, Vložit a propojit), zaznamená se vždy stejný kód ActiveSheet.Pictures.Insert("cesta").Select.
Ve výsledku je to ale jen odkaz na obrázek na disku.
Někde jsem našel Insert(Filename:= <path>, LinkToFile:= False, SaveWithDocument:= True), ale to hází chybu už při kompilování kódu:-(
Vovka(19.8.2015 15:57)#026313 
Po delším pátrání ve svém archlívu jsem objevil, jak jsem se se sejným problémem vypořádal:
Jmeno = Application.GetOpenFilename("Obrázky JPG (*.jpg), *.jpg")
With ActiveSheet
.Pictures.Insert Jmeno
.Shapes(1).Copy
.PasteSpecial Format:="Obrázek (JPEG)", _
Link:=False, DisplayAsIcon:=False
.Shapes(1).Delete
.Shapes(.Shapes.Count).Name = "Obraz"
End With
Pokud chci následně obrázek ořezat a nepotřebných ořezů se zbavit, je ještě nutné v Možnostech dovolit odstranění ořezaných částí.
citovatVovka(20.8.2015 0:49)#026315 Přesto, že můj kód z předchozího vstupu funguje jak má, nikdy se mi moc nelíbil, protože je to řešení hodně přes ruku. Před chvílí mne napadlo vyzkoušet jiný postup, který jsem úspěšně otestoval a který pokládám za daleko čistší. Navíc jde o jednořádkový kód:
Application.Dialogs(xlDialogInsertPicture).Show
Vybraný obrázek z vyvolaného dialogu se automaticky do listu vloží jako Shape.
citovatDíky moc, fungují oba kódy (první po drobné úpravě - mám už na listech jiné "shapes").
U prvního se mi víc líbí, že používá známý dialog, i když je "přes ruku".
citovatVovka(20.8.2015 9:12)#026318 Pokládám za škodu, že Dialog.Show nepatří mezi běžně používané techniky VBA. Vestavěné dialogy jsou vesměs užitečné, stručné a hlavně funkční.
Pro ty, kterým se víc líbí můj první postup, posílám upravené a komentované znění té procedury do knihovničky k archivaci:
Sub Pokus()
'**********************************************************
' fyzické vložení obrázku do listu bez linku na zdroj
'
' pro následné úpravy obrázku je vhodné pro tento sešit
' upravit Možnosti / Upřesnit / Velikost a kvalita obrázku:
' - zahodit data úprav - zaškrtnout
' - nastavit výchozí cílový výstup do 220 / 150 / 96 ppi
'**********************************************************
Dim Jmeno As String, Temp As String
' možné koncovky souborů: .jpg, .gif, .png
Jmeno = Application.GetOpenFilename("Obrázky JPG (*.jpg), *.jpg")
With ActiveSheet
.Pictures.Insert(Jmeno).Select ' link na obrázek
Temp = Selection.Name
.Shapes(Temp).Copy
.PasteSpecial Format:=1 ' 1-JPG; 2-GIF; 3-PNG
Selection.Name = "Obraz" ' obrázek bez linku
.Shapes(Temp).Delete ' smazání linku
End With
ActiveWindow.RangeSelection.Select
End Sub
Hezký den!
citovatKrásný příspěvek, díky ještě jednou:-)
citovat
RSS nejnovější články