[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
MJ13

MJ13

XLDnaute Barbatruc
Re : Aide: Erreur code incompatibilité de type

Bonjour Lone

Pour faire tourner ton chariot, tu peux tester ce code:

Code: 
Sub aTourne()
       For x = 0 To 10
        For i = 0 To 360
           Application.Wait Time:=Now() + 0.000001
            ActiveSheet.Shapes("GROUPE 30").Rotation = i
            'ActiveSheet.Shapes("Shape2").Rotation = 360 - i
        Next i
        Next x
End Sub

Pour le faire avancer, cela doit être facilement adaptable.
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Aide: Erreur code incompatibilité de type

Bonjour Michel,

merci pour la piste.

Mais il faut être un sacré champion pour faire un LOOPING avec un tel engin! :D ;)

Voici mon adaptation:

Code: 
Sub Avancer()
k = k + 1
       For x = 0 To 1
        For i = 0 To 360
           Application.Wait Time:=Now() + 0.000001
            ActiveSheet.Shapes("GROUPE 29").IncrementLeft k
            ActiveSheet.Shapes("Roue1").Rotation = 360 - i
            ActiveSheet.Shapes("Roue2").Rotation = 360 - i
        Next i
        Next x
        Call Appel
End Sub

Il ne me reste plus qu'à faire monter et déscendre les fourches.


A+ :cool:
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Aide: Erreur code incompatibilité de type

Re Michel,

voici l'avancement du code:

Code: 
Sub Avancer()
k = k + 1

       For x = 0 To 1
        For i = 0 To 360
           Application.Wait Time:=Now() + 0.000001
            ActiveSheet.Shapes("GROUPE 29").IncrementLeft k
            ActiveSheet.Shapes("Roue1").Rotation = 360 - i
            ActiveSheet.Shapes("Roue2").Rotation = 360 - i
        Next i
        Next x
              Application.Wait Time:=Now() + 0.00003
  
        For j = 1 To 2
        ActiveSheet.Shapes("Img12").Top = ActiveSheet.Shapes("Img12").Top - 30
        ActiveSheet.Shapes("Img13").Top = ActiveSheet.Shapes("Img13").Top - 30
        ActiveSheet.Shapes("Img16").Top = ActiveSheet.Shapes("Img16").Top - 30
        t = Timer + 1: Do Until Timer > t: DoEvents: Loop
        Next j
        Call Appel
End Sub
Sub Appel()
k = k - 1
        For x = 0 To 1
        For i = 0 To 360
           Application.Wait Time:=Now() + 0.000001
            ActiveSheet.Shapes("GROUPE 29").IncrementLeft k
            ActiveSheet.Shapes("Roue1").Rotation = i - 360
            ActiveSheet.Shapes("Roue2").Rotation = i - 360
        Next i
        Next x
        Application.Wait Time:=Now() + 0.00003

         For j = 1 To 2
         ActiveSheet.Shapes("Img12").Top = ActiveSheet.Shapes("Img12").Top + 30
        ActiveSheet.Shapes("Img13").Top = ActiveSheet.Shapes("Img13").Top + 30
        ActiveSheet.Shapes("Img16").Top = ActiveSheet.Shapes("Img16").Top + 30
        t = Timer + 1: Do Until Timer > t: DoEvents: Loop
        Next j
End Sub

Maintenant je n'arrive pas à faire monter les fourches doucement.
Ensuite, faire reculer un peu le chariot >petite attente > baisser les fourches et reculer.


A+ :cool:
 
Vote positif 0 Vote négatif
phlaurent55

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Aide: Erreur code incompatibilité de type

Bonjour à tous,

afin de réduire le code
il est possible de remplacer ceci:
Code: 
            ActiveSheet.Shapes("Re16").IncrementLeft k
            ActiveSheet.Shapes("Re17").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
par:
Code: 
ActiveSheet.Shapes("groupe 30").IncrementLeft k
à+
Philippe

Edit: le fichier en retour pour le cycle complet
 

Pièces jointes

  • elevateur.zip
    67 KB · Affichages: 43
  • elevateur.zip
    67 KB · Affichages: 48
  • elevateur.zip
    67 KB · Affichages: 43
Dernière édition:
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Aide: Erreur code incompatibilité de type

Re Philippe, pierrejean, Michel

J'ai adapté le code de Philippe pour réalisé la manoeuvre exacte lors de la prise d'une palette.
C'est vrai qu'il manque l'inclinaison des fourches, mais bon, c'est juste une démo.

Dommage que les roues ne tournent pas, à moin que...


A+ :cool:
 

Pièces jointes

  • elevateur V2.zip
    67.8 KB · Affichages: 40
Vote positif 0 Vote négatif
phlaurent55

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Aide: Erreur code incompatibilité de type

Re,
Dommage que les roues ne tournent pas, à moin que...
Cliquez pour agrandir...
c'est parce que les pneus sont dégonflés ;););)

plus sérieusement: pour pouvoir se rendre compte que les roues tournent, il ne faut pas qu'elles soient de couleur unie: j'ai transformé et mis un dégradé de couleurs

j'ai ajouté des instructions dans le code pour faire tourner les roues et j'ai du adapter la valeur ( n ) pour avoir une impression assez réaliste

voir fichier joint

à+
Philippe

ÉDIT: une petite suggestion:

il faudrait peut-être penser à changer l'intitulé de ce fil et le remplacer par "Déplacement et rotation de formes" ............. ça peut servir à d'autres !!!
 

Pièces jointes

  • elevateur.zip
    68.7 KB · Affichages: 54
  • elevateur.zip
    68.7 KB · Affichages: 59
  • elevateur.zip
    68.7 KB · Affichages: 59
  • elevateur_2.zip
    68.3 KB · Affichages: 52
Dernière édition:
Vote positif 0 Vote négatif
H

Habitude

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

Re

Et pour ceux que ca pourrait intéressé

Déplace du chariot par les flèches.
Gauche/droite le chariot
Haut/Bas les fourches

Permet aussi de choisir la vitesse de déplacement

Attention, modification des touches de flèches, réinitialisation dans le before close
 

Pièces jointes

  • Rotations-ImagesHabsFleche.xls
    138 KB · Affichages: 89
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
526
halecs93
halecs93
Ferbank
  • Question
XL 2019 modifier une macro
Réponses
2
Affichages
734
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
376
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
280
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
760
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
405
Mody200
M

Membres actuellement en ligne

12 membres et 126 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 108
Messages
2 085 380
Membres
102 876
dernier inscrit
BouteilleMan