< návrat zpět

MS Excel


Téma: VBA - Walking man rss

Zaslal/a 30.4.2014 18:57

Merlin99Zdravim
mam docela neobvykly dotaz na jednech anglickych strankach jsem videl ze dokazali MAKREM uvest obrazek do pohybu. Delam do skoly jeden projekt na modelace a myslim ze by to bylo velice prakticky tak kdyby nekdo tusil jak nato dejte vedet.. příklad v příloze 1

Příloha: rar19208_pokus9.rar (8kB, staženo 24x)
Zaslat odpověď >

Strana:  1 2   další »
icon #019211
avatar
Robí sa to tak, že obrázok panáčka si skopíruješ do riadku a makrom potom riadiš vlastnosť visible jednotlivých obrázkov - povedzme, že budeš mať 10 panáčikov, na začiatku bude viditeľný prvý obrázok a makrom potom prepínaš postupne viditeľnosť druhého, tretieho atď.; v každom kroku je vždy viditeľný iba jeden a ostatné sú skryté, to vyvolá ilúziu pohybu obrázka, v skutočnosti je v liste obrázkov niekoľko.

Iná možnosť je, že budeš makrom v cykle meniť hodnotu LEFT a TOP objektu SHAPE; v tomto prípade si vystačíš s jedným obrázkom panáčika a ten makrom po liste skutočne posúvať.citovat
#019212
Merlin99
AL díky za vysvetleni. Dale se chci zeptat nema nekdo neakej nazornej priklad vubec se totiz v tehle prikazech nevyznam potreboval bych videt jak to vypada funkcni ...citovat
icon #019214
avatar
Príklad na mnou popísaný druhý spôsob:

Do kódového okna Listu1 vlož:Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = [A1] And Target.Value = 1 Then Call MovePic
End Sub
Do okna modulu vlož:Option Explicit

Dim iniLft As Single
Sub MovePic()
Dim tillLft As Single
tillLft = Sheet1.Shapes("Obdélník 4").Left
With Sheet1.Shapes("Veselý oblièej 5")
iniLft = .Left
Do While .Left < tillLft
.Left = .Left + 10
Application.Wait (Now + 0.0000057)
Loop
End With
End Sub

Sub ResetPicPos()
Sheet1.Shapes("Veselý oblièej 5").Left = iniLft
End Sub
Makru ResetPicPos buď priraď tlačítko, alebo ho naviaž na nejaký event, obnoví východziu pozíciu toho panáčika.citovat
#019215
Merlin99
AL díky za příklad.. zkusil jsem tvuj postup a hazi mi to chyby ale jen proto ze jsem urco priradil spatne prikazy a vubec uz netusim... posílam v souboru
Příloha: rar19215_pokusp.rar (19kB, staženo 23x)
citovat
icon #019216
avatar
Sheet1 máš vo svojom projekte pomenovaný ako List1, takže v kóde to potom musí byť tiež List1. Okrem toho, musíš si skontrolovať diakritiku, správne v kóde má byť "Veselý obličej 5", ten editor na wall to zobrazuje v mojom príklade špatne. Chlape, to sú základy, než makro slepo nakopíruješ, tak sa ho snaž pochopiť! To je Tvoja domáca úloha, nie moja...

Inak, keby panáčik nemal precházdať z jedného domu do druhého, ale iba od jedného k druhému, tak alternatívne potom trebárs takto:Option Explicit

Sub MovePic()
Dim tillLft As Single
With Sheet1
tillLft = .Shapes("Obdélník 4").Left - .Shapes("Veselý obličej 5").Width
End With
With Sheet1.Shapes("Veselý obličej 5")
Do
.Left = .Left + 10
Application.Wait (Now + 0.0000057)
Loop While .Left < tillLft
.Left = tillLft - 5
End With
End Sub
Sub ResetPicPos()
With Sheet1
.Shapes("Veselý obličej 5").Left = .Shapes("Obdélník 1").Left + .Shapes("Obdélník 1").Width + 5
End With
End Sub
citovat
#019217
Merlin99
AL jo jo mas pravdu jsem zacatecnik tak se mi to presto nepodarilo rozpohybovat radsi se do tehle slozitejsich veci nebudu poustet tak diky za snahu 1
Příloha: rar19217_pokusp.rar (19kB, staženo 23x)
citovat
icon #019218
avatar
V prílohe posielam funkčné riešenie, čus.
Příloha: zip19218_pokusp.zip (20kB, staženo 26x)
citovat
#019219
Merlin99
JOOO to je přesně ono díky moc AL skvěle!citovat
#019220
Merlin99
AL este jeden dodatek kdybych potreboval aby sel panacek nasikmo jaky prikaz mam jen upravit .. díky 1citovat
icon #019222
avatar
Pokiaľ našikmo znamená napr. z ľavého horného do pravého dolného rohu obrazovky, tak okrem vlastnosti Left musíš v cykle meniť i vlastnosť Top objektu Shape (obrázku).citovat

Strana:  1 2   další »

Uživatelské menu

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

Menu

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.

On-line nástroje