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
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Hromadná zmena 1 obrázka za 2. obrázok
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
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
MS Excel
Téma: Hromadná zmena 1 obrázka za 2. obrázok 
Zaslal/a kabaka 5.11.2016 19:35
Potrebujem 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: 
33319_obrazky.zip (161kB, staženo 23x)
33319_obrazky.zip (161kB, staženo 23x)(7.11.2016 20:57)#033367
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
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
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
@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
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
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
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
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
(8.11.2016 22:31)#033383
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 Subcitovat
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 Subcitovat
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
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
(9.11.2016 0:13)#033385
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
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
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články