[Résolu] Déplacement et rotation de formes

Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Bonjour le Forum,

Voici mon premier code pour faire avancer et reculer un chariot élévateur.

Code: 
Sub Chariot()
k = k + 1
      
       For x = 0 To 1
        For i = 0 To 360
            ActiveSheet.Shapes("Img16").Rotation = 360 - i
            ActiveSheet.Shapes("Img17").Rotation = 360 - i
            ActiveSheet.Shapes("Img16").IncrementLeft k
            ActiveSheet.Shapes("Img17").IncrementLeft k
            ActiveSheet.Shapes("Img1").IncrementLeft k
            ActiveSheet.Shapes("Img2").IncrementLeft k
            ActiveSheet.Shapes("Img3").IncrementLeft k
            ActiveSheet.Shapes("Img4").IncrementLeft k
            ActiveSheet.Shapes("Img5").IncrementLeft k
            ActiveSheet.Shapes("Img6").IncrementLeft k
            ActiveSheet.Shapes("Img7").IncrementLeft k
            ActiveSheet.Shapes("Img8").IncrementLeft k
            ActiveSheet.Shapes("Img9").IncrementLeft k
            ActiveSheet.Shapes("Img10").IncrementLeft k
            ActiveSheet.Shapes("Img11").IncrementLeft k
            ActiveSheet.Shapes("Img12").IncrementLeft k
            ActiveSheet.Shapes("Img13").IncrementLeft k
            ActiveSheet.Shapes("Img14").IncrementLeft k
            ActiveSheet.Shapes("Img15").IncrementLeft k
            ActiveSheet.Shapes("Img18").IncrementLeft k
           t = Timer + 0.00001: Do Until Timer > t: DoEvents: Loop
        Next i
        Next x
        Call Char
End Sub

Sub Char()
k = k - 1
      
       For x = 0 To 1
        For i = 0 To 360
            ActiveSheet.Shapes("Img16").Rotation = i - 360
            ActiveSheet.Shapes("Img17").Rotation = i - 360
            ActiveSheet.Shapes("Img16").IncrementLeft k
            ActiveSheet.Shapes("Img17").IncrementLeft k
            ActiveSheet.Shapes("Img1").IncrementLeft k
            ActiveSheet.Shapes("Img2").IncrementLeft k
            ActiveSheet.Shapes("Img3").IncrementLeft k
            ActiveSheet.Shapes("Img4").IncrementLeft k
            ActiveSheet.Shapes("Img5").IncrementLeft k
            ActiveSheet.Shapes("Img6").IncrementLeft k
            ActiveSheet.Shapes("Img7").IncrementLeft k
            ActiveSheet.Shapes("Img8").IncrementLeft k
            ActiveSheet.Shapes("Img9").IncrementLeft k
            ActiveSheet.Shapes("Img10").IncrementLeft k
            ActiveSheet.Shapes("Img11").IncrementLeft k
            ActiveSheet.Shapes("Img12").IncrementLeft k
            ActiveSheet.Shapes("Img13").IncrementLeft k
            ActiveSheet.Shapes("Img14").IncrementLeft k
            ActiveSheet.Shapes("Img15").IncrementLeft k
            ActiveSheet.Shapes("Img18").IncrementLeft k
           t = Timer + 0.00001: Do Until Timer > t: DoEvents: Loop
        Next i
        Next x
End Sub

J'ai ensuite fait une tentative avec For each, toujours rien; j'ai repris For Next et
l'erreur sus-mentionnée s'affiche.

Code: 
Sub Test()
Dim sh$, shp$, num$(1 To 18), n$(16 To 17), k%

sh = Sheets("Feuil1").Shapes("Img" & num)
shp = Sheets("Feuil1").Shapes("Img" & n)
k = k + 1
       For x = 0 To 1
        For i = 0 To 360
shp.Rotation = 360 - i
sh.IncrementLeft k
t = Timer + 0.00001: Do Until Timer > t: DoEvents: Loop
Next i
Next x

k = k - 1
        For x = 0 To 1
        For i = 0 To 360
shp.Rotation = i - 360
sh.IncrementLeft k
t = Timer + 0.00001: Do Until Timer > t: DoEvents: Loop
Next i
Next x
End Sub

Vous voudriez bien ajouter le code pour faire monter et déscendre les fourches à la fin de la boucle qui fait avancer le chariot?

Merci d'avance


A+ :cool:
 

Pièces jointes

  • Rotations-Images.xls
    129.5 KB · Affichages: 82
Dernière édition:
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re : [Résolu] Déplacement et rotation de formes

Bonjourà tous


Sous Excel 2003, le fichier d'Habitude bug malheureusement :(
Le chariot refuse de rouler le bougre
mais je peux lever la fourche.
bug.png
Il semble ne pas trouver ces formes nommées
Code: 
ActiveSheet.Shapes("RoueAvant").Rotation = ActiveSheet.Shapes("RoueAvant").Rotation + 5
ActiveSheet.Shapes("RoueArriere").Rotation = ActiveSheet.Shapes("RoueAvant").Rotation + 5
 

Pièces jointes

  • bug.png
    bug.png
    5.1 KB · Affichages: 124
  • bug.png
    bug.png
    5.1 KB · Affichages: 130
Dernière édition:
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : [Résolu] Déplacement et rotation de formes

Salut Stapple,

ActiveSheet.Shapes("RoueArriere").Rotation = ActiveSheet.Shapes("RoueAvant").Rotation + 5

You Saw??? ;)

Sinon clique sur les pneus, sans les dégonflés :D, pour voir les noms.
J'ai aussi remis le nouveau fichier.

A+ :cool:
 

Pièces jointes

  • Elevateur.zip
    82.6 KB · Affichages: 37
  • Elevateur.zip
    82.6 KB · Affichages: 31
  • Elevateur.zip
    82.6 KB · Affichages: 40
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : [Résolu] Déplacement et rotation de formes

Re

avec le fichier de Loup Solitaire, c'est pire, je ne peux pas lever la fourche
même message d'erreur mais lVBE bloque ici
Function MoveUp()
If ActiveSheet.Shapes("Fourches").Top > ActiveSheet.Shapes("Chassis").Top - 60 Then _
ActiveSheet.Shapes("Fourches").IncrementTop [B2] * -1

End Function
Cliquez pour agrandir...

PS:
You saw ???
Cliquez pour agrandir...

Voici le code VBA du fichier d'Habitude (sans aucune modif de ma part)
Code: 
Function MoveRight()
If ActiveSheet.Shapes("Chassis").Left < 600 Then
ActiveSheet.Shapes("RoueAvant").Rotation = ActiveSheet.Shapes("RoueAvant").Rotation - 5
ActiveSheet.Shapes("RoueArriere").Rotation = ActiveSheet.Shapes("RoueAvant").Rotation - 5
ActiveSheet.Shapes("Chassis").IncrementLeft [B1]
ActiveSheet.Shapes("Fourches").IncrementLeft [B1]
ActiveSheet.Shapes("Inclinaison").IncrementLeft [B1]
End If
End Function

Donc j'ai bien see que ce j'ai see
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : [Résolu] Déplacement et rotation de formes

Re

Parce ce que ce week-end, je ne suis pas sur mon PC tout simplement.
;)
Le plus important étant que d'autres membres du forum sous 2003 veulent peut-être tester ton chariot ;)

PS: j'ai bien vu que les noms sont les bons en cliquant dessus.
J'ai remarqué qu'il y avait aussi deux formes nommées Ellipse63 et Ellipse64.

Est-ce la un début de piste ?
 
Dernière édition:
Vote positif 0 Vote négatif
H

Habitude

XLDnaute Accro
Re : [Résolu] Déplacement et rotation de formes

Re

Les roues font partie du groupe "Chassis"
Les fourches ont leur propre groupe.
Je crois que 2003 ne reconnait plus le nom individuel d'une frame lorsque celle-ci fait partie d'un groupe.
En 2003, le relief des roues disparait aussi. (on ne voit plus la rotation)

Donc version 2003 avec groupe roue indépendant de chassis
 

Pièces jointes

  • MouvementHabsFleche2003.xls
    135.5 KB · Affichages: 40
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : [Résolu] Déplacement et rotation de formes

Re

Merci Habitude pour ce downgrade.
J'ai testé sous Excel 2000, cela fonctionne aussi.

PS: je n'ai pas Excel 97 sous le coude, mais je ne crois pas qu'il reste un membre du forum avec cette version
(enfin j'espère ;) )
 
Vote positif 0 Vote négatif
Victor21

Victor21

XLDnaute Barbatruc
Re : [Résolu] Déplacement et rotation de formes

Bonjour à tous, bonjour Habitude.

Chez moi, les roues tournent à l'envers !
On va user les pneus : j'ai dû installer un miroir à droite de mon écran

Blague à part, très instructif, cet exercice de style. Merci à vous.
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : [Résolu] Déplacement et rotation de formes

Bonjour Patrick, MDR!! LOL!

Habitude, j'ai un petit souci avec l'inclinaison; les fourches sont un peu éloignées du Mât et je n'arrive pas à le corriger.

Tu voudrais bien regarder?


A+ :cool:
 

Pièces jointes

  • Elevateur.zip
    84.8 KB · Affichages: 21
  • Elevateur.zip
    84.8 KB · Affichages: 23
  • Elevateur.zip
    84.8 KB · Affichages: 23
Vote positif 0 Vote négatif
H

Habitude

XLDnaute Accro
Re : [Résolu] Déplacement et rotation de formes

Re
Difficile de tester
Ton chariot ne se respositionne pas.

Pour ton inclinaison essaie ceci
'Inclinaison de la charge
Code: 
For n = 1 To 6
            ActiveSheet.Shapes("Mat").Rotation = -n
            ActiveSheet.Shapes("Charge").Rotation = -n
            ActiveSheet.Shapes("Fourches").Left = ActiveSheet.Shapes("Fourches").Left - 3 / 6
            ActiveSheet.Shapes("Fourches").Rotation = -n
            ActiveSheet.Shapes("Charge").Left = ActiveSheet.Shapes("Fourches").Left + 10
        Next n

Tu va devoir aussi ajuster le déplacement lors de la descente en inclinaison
 
Vote positif 0 Vote négatif

Discussions similaires

halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
550
halecs93
halecs93
Ferbank
  • Question
XL 2019 modifier une macro
Réponses
2
Affichages
746
Ferbank
Ferbank
patricktoulon
  • Question
XL 2013 crer une liste de nombres aleatoires entre un min et un max avec une fonction VBA méthode particulière
5 6 7
Réponses
94
Affichages
2 K
patricktoulon
patricktoulon
B
  • Résolu(e)
Microsoft 365 affecter des valeurs dans un tableau de noms de variable
Réponses
4
Affichages
404
bérylion
B
M
  • Question
XL 2019 Optimisation de code VBA
2 3
Réponses
33
Affichages
2 K
mmaiga
M
W
  • Question
XL 2016 Supprimer une image.JPG puis Intégrer une nouvelle.JPG au-dessus du groupe de cellules A13:A14
Réponses
4
Affichages
293
Webperegrino
W
Dadi147
  • Résolu(e)
XL 2016 Récupérer les données de nom et de date VBA
2 3
Réponses
35
Affichages
2 K
Oneida
Oneida
R
  • Question
Microsoft 365 ListBox / ListView et combobox avec choix de colonnes
2
Réponses
20
Affichages
3 K
RaVenSs
R
O
  • Résolu(e)
XL 2019 Moyenne de valeurs par date à partir d'un tableau
Réponses
4
Affichages
780
Olocsob
O
M
  • Question
XL 2010 Calcul possible dans la zone de liste pour le débit et le crédit lors d'une recherche basée sur la zone de texte
Réponses
0
Affichages
430
Mody200
M

Membres actuellement en ligne

8 membres et 91 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 305
Messages
2 087 087
Membres
103 461
dernier inscrit
dams94