Mne nie.
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Tipy a triky pro Excel a makra VBA
< návrat zpět
Téma: Hromadná zmena 1 obrázka za 2. obrázok
hmmm zaujimavé... tak potom neviem, kde je chyba
Mohol by si mi prosím poslať Tvoj súbor s týmto makrom? Že ako mi to bude zobrazovať? Či mi to bude deformovať, alebo nie?
Ďakujem za trpezlivosť.
Tak ja už neviem, kde je chyba, mne to deformuje. Nemôže to byť spôsobené nekompatibilitou officov?
prosím Ťa, kde všade to mám vložiť,aby to fungovalo, vložila som to iba sem a je to bez zmeny
Sub Test()
Const myPicName As String = "D:\meno\podklady\obrázky\2.jpg
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
For i = 1 To 11
For j = 1 To 4
Set pic = ActiveSheet.Pictures.Insert(myPicName)
With pic
.ShapeRange.LockAspectRatio = msoTrue
.Top = Cells(i, j).Top + 3
.Left = Cells(i, j).Left + 3
If .Height > h Then .Height = h
If .Width <= w Then .Left = .Left + (w - .Width) / 2
If .Width > w Then .Width = w
If .Height <= h Then .Top = .Top + (h - .Height) / 2
End With
Next j
Next i
End Sub
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)
33348_printscreen.jpg
AL napsal/a:
Mne nie.Příloha: 33348_printscreen.jpg
hmmm zaujimavé... tak potom neviem, kde je chyba
Mohol by si mi prosím poslať Tvoj súbor s týmto makrom? Že ako mi to bude zobrazovať? Či mi to bude deformovať, alebo nie?
Ďakujem za trpezlivosť.
Žiadny nový súbor som nevytváral. Použil som tvoju prílohu, makro som písal priamo do nej.
Příloha: 33351_obrazky.zip (29kB, staženo 21x)
33351_obrazky.zip (29kB, staženo 21x)AL napsal/a:
Žiadny nový súbor som nevytváral. Použil som tvoju prílohu, makro som písal priamo do nej.Příloha: 33351_obrazky.zip
Tak ja už neviem, kde je chyba, mne to deformuje. Nemôže to byť spôsobené nekompatibilitou officov?
Hoci si nemyslím, že kompatibilita by mohla v tomto prípade hrať úlohu, istotu nemám. Na 2003 nemám možnosť otestovať a hľadať zdokumentované problémy kompatibility fakt nebudem. Ten kód nie je nijako zložitý, keby som sedel u 2003, tak by som si ja kód odkrokoval a hľadal v kóde miesto, kde to nefunguje podľa predpokladov.
Chrobáčik, vlož si tam zamknutí stran.
With pic
.ShapeRange.LockAspectRatio = msoTrue
.Top = Cells(i, j).Top + 3
.Left = Cells(i, j).Left + 3
'atd.
With pic
.ShapeRange.LockAspectRatio = msoTrue
.Top = Cells(i, j).Top + 3
.Left = Cells(i, j).Left + 3
'atd.
@Anymen
To je zaujímavé. Sedím teraz pri služobnom notebooku. Vložím nejaký úplne iný obrázok do sheetu, a pomer strán mám zamknutý automaticky. Kód som tvoril na privátnom stroji a keďže obrázok nedeformovalo, tak predpokladám, že tam to bolo nastavené rovnako. Predpokladám teda, že sa jedná o defaultné nastavenie v 2016. V tých 2003 je to možno inak. Alebo si Excel pamätá, ako to užívateľ nastavil v minulosti - akurát nikde v možnostiach nastavenia nevidím možnosť defaultne zmeniť na odomknutie pomeru strán (vo vlastnostiach konkrétneho obrázku samozrejme áno). Každopádne, určite nie je na škodu do makra pridať tú tvoju inštrukciu, minimálne z dôvodu, aby bola istota, že pomer strán zostane zamknutý.
To je zaujímavé. Sedím teraz pri služobnom notebooku. Vložím nejaký úplne iný obrázok do sheetu, a pomer strán mám zamknutý automaticky. Kód som tvoril na privátnom stroji a keďže obrázok nedeformovalo, tak predpokladám, že tam to bolo nastavené rovnako. Predpokladám teda, že sa jedná o defaultné nastavenie v 2016. V tých 2003 je to možno inak. Alebo si Excel pamätá, ako to užívateľ nastavil v minulosti - akurát nikde v možnostiach nastavenia nevidím možnosť defaultne zmeniť na odomknutie pomeru strán (vo vlastnostiach konkrétneho obrázku samozrejme áno). Každopádne, určite nie je na škodu do makra pridať tú tvoju inštrukciu, minimálne z dôvodu, aby bola istota, že pomer strán zostane zamknutý.
Al, matně si vzpomínám(nejsem si jistý), že v E2003 si to pamatovalo poslední volbu, tedy i "False".
O.k. ďakujem, budem na to myslieť :). Ja si spomínam, že pred nejakou dobou v nejakom scripte som to musel tiež nastavovať priamo v kóde. Ale poznáš to, čo nedokážeš nasimulovať, to sa ladí ťažko..
Anymen napsal/a:
Chrobáčik, vlož si tam zamknutí stran.
With pic
.ShapeRange.LockAspectRatio = msoTrue
.Top = Cells(i, j).Top + 3
.Left = Cells(i, j).Left + 3
'atd.
prosím Ťa, kde všade to mám vložiť,aby to fungovalo, vložila som to iba sem a je to bez zmeny
Sub Test()
Const myPicName As String = "D:\meno\podklady\obrázky\2.jpg
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
For i = 1 To 11
For j = 1 To 4
Set pic = ActiveSheet.Pictures.Insert(myPicName)
With pic
.ShapeRange.LockAspectRatio = msoTrue
.Top = Cells(i, j).Top + 3
.Left = Cells(i, j).Left + 3
If .Height > h Then .Height = h
If .Width <= w Then .Left = .Left + (w - .Width) / 2
If .Width > w Then .Width = w
If .Height <= h Then .Top = .Top + (h - .Height) / 2
End With
Next j
Next i
End Sub
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