XL 2010 Déplacement de plusieurs zones de texte dans excel vba

[Gnedea]

Salut
J'ai encore besoin de votre aide
J'ai un fichier excel dans lequel je souhaite déplacer des zones de texte par VBA.
J'ai essayé une Macro mais je n'y parviens pas quelqu'un peut il m'aider à résoudre ce problème s'il vous plaît ?
Voici mon fichier

 

[Jacky67]

Salut
J'ai encore besoin de votre aide
J'ai un fichier excel dans lequel je souhaite déplacer des zones de texte par VBA.
J'ai essayé une Macro mais je n'y parviens pas quelqu'un peut il m'aider à résoudre ce problème s'il vous plaît ?
Voici mon fichier

Bonjour,
Comme prévu, les complications commencent..🙄🙄
Il faudra mettre de l'ordre, il y a déjà des zones superposées.

En numéros la zone à déplacer de 1 à 29 (ZoneTexte 1, ZoneTexte 2......ZoneTexte 29)
Et la zone destination de 100 à 2900 (ZoneTexte 100, ZoneTexte 200.....ZoneTexte 2900)
Cette macro le fera

Private Sub CommandButton1_Click()
    Dim i&
    For i = 1 To 29
        With Feuil2
            .Shapes("ZoneTexte " & i).Left = .Shapes("ZoneTexte " & i * 100).Left
            .Shapes("ZoneTexte " & i).Top = .Shapes("ZoneTexte " & i * 100).Top
        End With
    Next
End Sub

Ps; Pour mon info perso., à quoi cela va-t-il servir ?????

 

[Gnedea]

Bonjour,
Comme prévu, les complications commencent..🙄🙄
Il faudra mettre de l'ordre, il y a déjà des zones superposées.

En numéros la zone à déplacer de 1 à 29 (ZoneTexte 1, ZoneTexte 2......ZoneTexte 29)
Et la zone destination de 100 à 2900 (ZoneTexte 100, ZoneTexte 200.....ZoneTexte 2900)
Cette macro le fera

Private Sub CommandButton1_Click()
    Dim i&
    For i = 1 To 29
        With Feuil2
            .Shapes("ZoneTexte " & i).Left = .Shapes("ZoneTexte " & i * 100).Left
            .Shapes("ZoneTexte " & i).Top = .Shapes("ZoneTexte " & i * 100).Top
        End With
    Next
End Sub

Ps; Pour mon info perso., à quoi cela va-t-il servir ?????

Salut Jacky67 lorsque je lance la macro on un message s'affiche ''l'element portant ce nom est introuvable''

 

[mapomme]

Bonsoir @Gnedea 🙂,

Personnellement, je ne comprends rien à ce que vous désirez faire 🙁. La figure de droite (B) est la même que la figure de gauche (A). Je ne vois pas de superposition ???

 

[Phil69970]

Bonjour à tous

Perso je rejoins jacky et mapomme

Comme prévu, les complications commencent..🙄🙄

je ne comprends rien à ce que vous désirez faire

Et comme le demandeur n'explique rien sur la finalité de sa demande on découvre la machine infernale au fil de ses demandes .....

Une usine à gaz est en marche ....
Qui pourra l’arrêter avant l'explosion ?? 🤣

 

[vgendron]

Hello

en reprenant et modifiant la propostion de Jacky

Sub déplace()
Dim i&
    For i = 1 To 29
        With Feuil2
            .Shapes("ZoneTexte " & i).Left = .Shapes("ZoneTexte " & i).Left + .Range("M1").Left
        End With
    Next
    Application.ScreenUpdating = True
End Sub

 

[sylvanu]

Bonjour tout le monde,
@Gnedea,
Au vu de toutes ces questions, peut être serait ce utile d'expliquer à quoi ça sert ?
Et de l'avis général, autant de shapes .... "Qui pourra l’arrêter avant l'explosion ?? " 😉
Si vos shapes ne sont pas indispensables, on peut peut être les remplacer par de simples cellules. Dans ce cas le déplacement devient enfantin.

 

[sylvanu]

Et si vous tenez à vos shapes, alors regardez cette PJ avec :

Sub GaucheDroite()
    Range("B5:J24").Cut Destination:=Range("O5:W24")
    Range("A1").Select
End Sub
Sub DroiteGauche()
    Range("O5:W24").Cut Destination:=Range("B5:J24")
    Range("A1").Select
End Sub

 

[Jacky67]

Salut Jacky67 lorsque je lance la macro on un message s'affiche ''l'element portant ce nom est introuvable''

RE..
C'est que les recommandations n'ont pas été respectées.
Bon,.....en continuant sans réfléchir à la finalité de ce projet, la Pj fait ce que tu demandes.

 

[Jacky67]

Je ne vois pas de superposition ???

Hello mapomme
Si, si il y a déjà le bord..l, pardon, superposition dans son classeur.

 

[vgendron]

@Jacky67 Hello

ce que j'ai compris, c'est que dans le fichier fourni par le demandeur, il y a à la fois le fichier de départ (shapes de 1 à 29 à gauche) ET le résultat attendu (les shapes 100 à...) à droite
et pour ca.. il a fait un copier coller ..
mais au final (si j'ai toujours bien compris) il faut juste que les shapes 1 à 29 soient déplacées de gauche à droite

 

[vgendron]

d'ou la proposition que j'ai faite à partir de la tienne (@Jacky67) en post 6
mais évidemment.. pour éviter la superposition. il faut supprimer les shapes de droite avant de lancer la macro..

 

[Jacky67]

@Jacky67 Hello

ce que j'ai compris, c'est que dans le fichier fourni par le demandeur, il y a à la fois le fichier de départ (shapes de 1 à 29 à gauche) ET le résultat attendu (les shapes 100 à...) à droite
et pour ca.. il a fait un copier coller ..
mais au final (si j'ai toujours bien compris) il faut juste que les shapes 1 à 29 soient déplacées de gauche à droite

Hello vgendron
Le demandeur ne donne aucune explication, du moins cohérente, ni ici, ni dans un post précèdent du même genre.
Je crois que je vais mettre fin à mes propositions.
Bonne journée

 

[mapomme]

Bonjour à tous😉,

Pour faire avancer la chose, une interprétation toute personnelle :

• on ne s'intéresse qu'aux formes entièrement incluses dans la zone source
• on peut effacer les formes entièrement incluses dans la zone cible (si on ne les efface pas alors c'est une superposition)

Le code commenté est entièrement dans le module de la feuille :

Sub SensAB()
   ShapePlageSourceVersCelluleCible Range("b5:j23"), Range("o5")
End Sub

Sub SensBA()
   ShapePlageSourceVersCelluleCible Range("o5:w24"), Range("b5")
End Sub

Sub ShapePlageSourceVersCelluleCible(PlageSource As Range, CelluleCible As Range)
Dim PlageCible As Range, xrgHaut As Range, xrgBas As Range, x As Shape, dx#, dy#, repSuppr
   ' plage cible (débute en CelluleCible et de mêmes dimensions que PlageSource
   Set PlageCible = CelluleCible.Resize(PlageSource.Rows.Count, PlageSource.Columns.Count)
   ' suppression des formes de la plage cible (à confirmer)
   ' si pas de suppression alors on ajoute les formes de la plage A vers la Plage B, c'est une
   ' espèce de superposition
   repSuppr = MsgBox("Voulez-vous supprimer toutes les formes ""ENTIèREMENT"" incluses" & _
      " dans la zone cible ? (pas de retour possible !)", vbYesNo + vbQuestion + vbDefaultButton2)
   If repSuppr = vbYes Then
      repSuppr = MsgBox("CONFIRMEZ-VOUS la suppression de toutes les formes ""ENTIèREMENT"" incluses" & _
      " dans la zone cible ? (pas de retour possible !)", vbYesNo + vbQuestion + vbDefaultButton2)
      If repSuppr = vbYes Then
         For Each x In Me.Shapes ' on supprime les formes "ENTIéREMENT" incluses dans la plage cible
            If Not Intersect(x.TopLeftCell, PlageCible) Is Nothing Then
               If Not Intersect(x.BottomRightCell, PlageCible) Is Nothing Then x.Delete
            End If
         Next x
      End If
   End If
   ' Translation à faire : dx déplacement horizontal - dy déplacement vertical
   dx = PlageCible.Left - PlageSource.Left: dy = PlageCible.Top - PlageSource.Top
   ' déplacement des formes "ENTIéREMENT" incluses dans la plage source vers la plage cible
   For Each x In Me.Shapes ' pour chaque forme x de la feuille
      ' si x est "ENTIéREMENT" incluse dans la plage source alors on la déplace vers la cible
      If Not Intersect(x.TopLeftCell, PlageSource) Is Nothing Then
      If Not Intersect(x.BottomRightCell, PlageSource) Is Nothing Then
         x.Top = x.Top + dy: x.Left = x.Left + dx  ' déplacement par translation (dy,dx)
         x.ZOrder msoBringToFront   ' la forme qu'on vient de déplacer est mise à l'avant-plan
      End If: End If
   Next x
End Sub

 

[vgendron]

pour le fun, ce que j'avais fait avant la propostion de Mapomme

Sub déplace()
Dim i&
    With Feuil2
        Set Source = Application.InputBox("cliquez dans la cellule de gauche de la zone source", Type:=8)
        Set cible = Application.InputBox("cliquez dans la cellule de gauche de la zone destination", Type:=8)
        
        If Source.Left < cible.Left Then
            DéplHori = cible.Left
        Else
            DéplHori = cible.Left - Source.Left
        End If
        If Source.Top < cible.Top Then
            DéplVert = cible.Top
        Else
            DéplVert = cible.Top - Source.Top
        End If
        For i = 1 To 29
            .Shapes("ZoneTexte " & i).IncrementLeft DéplHori
            .Shapes("ZoneTexte " & i).IncrementTop DéplVert
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub