Rapport de message :*
 

Re: Afficher zones de texte de la plus grande à la plus petite

Titre du sujet : Re: Afficher zones de texte de la plus grande à la plus petite
par myDearFriend! le 24/03/2012 12:35:01

Bonjour Jacky, le Forum,

Je pratique Excel depuis un peu plus de dix ans, il est sûr que j'ai réalisé quelques fichiers... mais je ne reconnais absolument pas ma façon de coder VBA dans ce document, ni le reste (ce qui n'enlève rien à la qualité du travail de l'auteur original, hein ! ).

Je te confirme donc que je ne suis pas l'auteur de ce fichier et, après recherche, je puis même te dire que l'auteur est Fring (Fred) de nos amis de Développez.com. Le vrai fichier original est sous CE LIEN.

J'ajoute que si, comme c'était le cas dans le classeur d'origine, tu avais laissé le nom de l'auteur dans les propriétés (Fred), c'était d'une part une bonne façon d'éclaircir ce point et d'autre part, ça reste la meilleur façon de remercier le véritable auteur de ce document à caractère pédagogique.

Pour en revenir à ta question et selon le peu d'info finalement laissée à ma disposition, tu trouveras ci-joint le fichier modifié selon mon interprétation du problème...

J'ai utilisé le code VBA suivant :
Option Explicit

'myDearFriend! -  www.mdf-xlpages.com
Sub Ajouter2emeCouple()
Dim Obj As Shape
Dim T As String
Dim Cpt As Integer

    Cpt = ActiveSheet.Shapes.Count
    'Duplication des Shapes
    For Each Obj In ActiveSheet.Shapes
        T = Obj.TextFrame.Characters.Text
        If T Like Range("A2") & "*" Then
            AjouterCouple Obj, T, Cpt
            Cpt = Cpt + 1
        End If
    Next Obj
End Sub

Sub AjouterCouple(Obj As Shape, T As String, N As Integer)
    Obj.Copy
    ActiveSheet.Paste
    With Selection
        .Name = "zonetxt" & N
        .Characters.Text = Replace(T, Range("A2").Text, Range("B2").Text)
        .Top = Obj.Top
        .Left = Obj.Left + Obj.Width + 5
    End With
End Sub

En espérant que ça puisse t'aider.

Cordialement,