< návrat zpět

MS Excel


Téma: Hromadná zmena 1 obrázka za 2. obrázok rss

Zaslal/a 5.11.2016 19:35

kabakaPotrebujem hromadne zmeniť 1 obrázok za 2 obrázok z databázy.
Vo worde alebo v exceli (2003)
Ak existuje elegantnejšie riešenie v grafickom programe, prosím nasmerujte ma naň (najlepšie freeware, jednoduchý, v slovenčine, ale to chcem, asi veľa:))

cesta D:\meno\dokumenty\podklady\obrázky

Ďakujem

Příloha: zip33319_obrazky.zip (161kB, staženo 23x)
Zaslat odpověď >

Strana:  « předchozí  1 2 3 4 5   další »
#033367
avatar
Hm, no dobře. Rozděl si zobrazení tak, aby si viděla i List i Editor zároveň. V Editoru dej kurzor na začátek Procedury. Tisknutím "F8" krokuj Makro a sleduj co se děje, na kterém řádku dojde k deformaci. Víc neporadím.citovat
icon #033368
avatar
Napadlo ma, že pokiaľ sa nastavuje zamknutie pomeru strán až po tom, čo je obrázok už vložený, nemusí to fungovať, pretože bude zamknutý pomer strán až už zdeformovaného obrázku. Nasledujúci tip považuj za výstrel do tmy:
Skús vložiť tú inštrukciu i pred riadok kódu s inštrukcioupic.DeleteEšte by sa dalo skúsiť nahradiť konštantu msoTrue za TRUE. Inak už tiež neviem, i hore uvedené je bez záruky. Ako píše kolega, skús odkrokovať makro, to už som tiež navrhoval v jednom z minulých príspevkov..citovat
#033370
kabaka

Anyman napsal/a:

Hm, no dobře. Rozděl si zobrazení tak, aby si viděla i List i Editor zároveň. V Editoru dej kurzor na začátek Procedury. Tisknutím "F8" krokuj Makro a sleduj co se děje, na kterém řádku dojde k deformaci. Víc neporadím.


Tak konečne sa mi podarilo odkrokovať makro. A prišla som na toto.

v tomto kroku je obrázok OK
If .Height > h Then .Height = h

a v tomto kroku ho zdeformuje
If .Width <= w Then .Left = .Left + (w - .Width) / 2citovat
icon #033371
eLCHa
@kabaka
nebudu to číst celé, takže pokud to tu už je, tak to ignorujte.

Umístěte kurzor na list.
Stiskněte CTRL+G
Dejte Jinak... (nevím, jak je to ve vašem excelu, takže to tlačítko vlevo dole)
Zvolte Objekty a dejte OK

Dejte Změnit obrázek - to si musíte v excelu 2003 najít kde se to dělá, já mám 2010 a tam je to v Ribbonu.

Pokud se vám to deformuje, je chyba někde v nastavení - může být excel, ale teoreticky může být i windows.
Pokud ne, máte něco chybně v kódu.
Pokud to nemusí být kódem, tak máte i řešení.

U mne to nedeformovalo.citovat
icon #033373
avatar
Karle, za F5 chválim. V jednoduchosti je krása. :)citovat
#033374
kabaka

eLCHa napsal/a:

U mne to nedeformovalo.


Tak neviem, či to pomôže. Prišla som nato, že keď zväčším bunky, tak sa mi tam nakopíruje obrázok nezdeformovaný. Ale keď dám iný obrázok do rovnako veľkých buniek, tak sa zdeformuje. Jednoducho sa veľkosť obrázku prispôsobí bunke. Neviem ako zabezpečiť, aby sa bunka prispôsobila obrázku a nie naopak.citovat
icon #033376
eLCHa
Tady si budete muset asi pomoci sama, protože, u mne to funguje dle zadání. Tedy změním najednou všechny obrázky a jsou nedeformované. Jsou pouze přizpůsobené aktuálnímu nastavení.
Pokud chcete přizpůsobovat rozměry buňky obrázku, to je jiná úloha.
Asi bych nastavil
Přesun a změna velikosti,
a pak změnil rozměry buňky - dle rozměru obrázku.
Ale vlastně mi není úplně jasné, co má být konečný stav.citovat
#033383
avatar
Poslední pokus:Sub Menit_Obrazek()
Const myPicName As String = "D:\meno\dokumenty\podklady\obrázky\2.jpeg"
Dim pic As Picture, i As Byte, j As Byte, w As Single, h As Single
For Each pic In ActiveSheet.Pictures
pic.Delete
Next pic
h = [A1].Height - 6
w = [A1].Width - 6
Set pic = ActiveSheet.Pictures.Insert(myPicName)
With pic
.ShapeRange.LockAspectRatio = msoTrue
If .Height > h Then .Height = h
If .Width > w Then .Width = w
.Cut
End With
For i = 1 To 11
For j = 1 To 4
With ActiveSheet.Pictures.Paste
.Top = Rows(i).Top + (h - .Height) / 2 + 3
.Left = Columns(j).Left + (w - .Width) / 2 + 3
End With
Next j
Next i
End Sub

Sub Menit_Bunku()
Const myPicName As String = "D:\meno\dokumenty\podklady\obrázky\2.jpeg"
Dim pic As Picture, i As Byte, j As Byte, w As Single, h As Single
For Each pic In ActiveSheet.Pictures
pic.Delete
Next pic
Set pic = ActiveSheet.Pictures.Insert(myPicName)
With pic
.ShapeRange.LockAspectRatio = msoTrue
h = .Height + 6
w = .Width + 6
.Cut
End With
With Columns(1)
For i = 1 To 3
.ColumnWidth = w / .Width * .ColumnWidth
Next i
End With
With Range(Cells(1, 1), Cells(11, 4))
.RowHeight = h
.ColumnWidth = Columns(1).ColumnWidth
End With
For i = 1 To 11
For j = 1 To 4
With ActiveSheet.Pictures.Paste
.Top = Cells(i, j).Top + 3
.Left = Cells(i, j).Left + 3
End With
Next j
Next i
End Sub
citovat
icon #033384
avatar
Ahoj. U toho druheho kodu nejak nie som schopny pochopit ten cyklus

For i = 1 To 3
.ColumnWidth = w / .Width * .ColumnWidth
Next i

Konkretne: preco sa to opakuje 3 krat?
Nema tam byt pic.Width v menovateli?
Pozeram na to v mobile, nesedim u excelu, takze nemam moznost otestovat. Ale nejak si nedokazem predstavit, co to ma robit? Preco 3 krat..citovat
#033385
avatar
No to není můj vynález, ale už jsem to párkrát použil. Čerpáno např. tady
http://stackoverflow.com/questions/28561877/why-does-the-units-of-range-columnwidth-not-match-either-points-or-centimeters
a je to funkční.
Ale vůbec nechápu, proč se jí to po změně "Left" deformuje.citovat

Strana:  « předchozí  1 2 3 4 5   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09