Appliquer une boucle à un range("XX:XX")

Question

Bonsoir à tous ce bout de code effectue un copier coller :

- d'une zone de texte nommée "ZTXT3" ainsi que d'une plage E4:E13 le tout l'un en dessous de l'autre dans un commentaire E3

J'ai pu lui associer une boucle pour qu'elle fasse de même pour Ztxt14, ZTXT25, ZTXT36,.... donc avec un saut de 11 lignes (J'ai nommé ces zones de texte en rapport à la ligne correspondante EX : Ztxt14 est associé à la ligne 14 pour une éventuelle boucle traitant ces lignes).

Ca marche nickel, cependant je bug pour appliquer une boucle à cette ligne :

msge = msge & Chr(10) & Chr(10) & Join(Application.Transpose(Range("E4:E13")), Chr(10))

Je tente de faire une boucle similaire afin de copier les plages

E4:E13 en com E3

E15:E24 en com E14

E26:E35 en com E25

E114:E123 en com E113

Voici le code complet, et un screen si vous voulez.

Sub ok()
DIM boucle1 as integer
Application.ScreenUpdating = False

For boucle1 = 3 To 124 Step 11

                    With Range("E" & boucle1) 
                        Dim txBox As Shape, msge
                        Set txBox = ActiveSheet.Shapes("ZTXT" & I)
                        msge = txBox.TextFrame.Characters.Text

                        msge = msge & Chr(10) & Chr(10) & Join(Application.Transpose(Range("E4:E13")), Chr(10))
                        .ClearComments
                        .AddComment
                        .Comment.Text Text:=msge
                        .Comment.Shape.Width = 360
                        .Comment.Shape.Height = 500
                        .Comment.Shape.TextFrame.Characters.Font.Size = 12
                        'txBox.TextFrame.Characters.Text = ""
                    End With

Next boucle1
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Merci du temps consacré.

PS : Je tenais à vous dire un grand merci car sans vous j'aurais avancé péniblement

cousinhub · Answer

Comme dirait mon garagiste, à qui j'ai pourtant envoyé une photo de ma voiture en panne, tu peux essayer comme ça : Sub ok() Dim I As Integer Dim txBox As Shape Dim Msge As String Application.ScreenUpdating = False For I = 3 To 124 Step 11 With Range("E" &amp; I) Set txBox = ActiveSheet.Shapes("ZTXT" &amp; I) Msge = txBox.TextFrame.Characters.Text Msge = Msge &amp; Chr(10) &amp; Chr(10) &amp; Join(Application.Transpose(.Offset(1, 0).Resize(10)), Chr(10)) .ClearComments .AddComment .Comment.Text Text:=Msge .Comment.Shape.Width = 360 .Comment.Shape.Height = 500 .Comment.Shape.TextFrame.Characters.Font.Size = 12 'txBox.TextFrame.Characters.Text = "" End With Next I Application.ScreenUpdating = True Application.CutCopyMode = False End Sub Si ça bug, et toujours comme dirait mon garagiste, il va falloir amener la voiture.... (dans ton cas, joindre un fichier.....) Bonne soirée...

cousinhub · Answer

Re-,

Ce qu'il y a de bien, c'est que tu n'as même pas essayé le code proposé (du moins, il n'apparaît pas dans ton fichier....)

Et de plus, la structure du fichier joint ne correspond pas du tout à ce que tu as demandé....

Bref, est-ce que le code proposé fonctionne, ou non?

Re-,

Code qui fonctionne chez moi, pour ton fichier exemple.

Sub ok()
Dim I As Integer
Dim txBox As ShapeRange
Dim Msge As String
Application.ScreenUpdating = False
For I = 1 To 11 Step 5
    With Range("A" & I)
        Set txBox = ActiveSheet.Shapes.Range(Array("ZoneDeTexte" & I))
        Msge = txBox.TextFrame.Characters.Text
        Msge = Msge & Chr(10) & Chr(10) & Join(Application.Transpose(.Offset(1, 0).Resize(4)), Chr(10))
        .ClearComments
        .AddComment
        .Comment.Text Text:=Msge
        .Comment.Shape.Width = 360
        .Comment.Shape.Height = 500
        .Comment.Shape.TextFrame.Characters.Font.Size = 12
        'txBox.TextFrame.Characters.Text = ""
    End With
Next I
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Bon courage

cousinhub · Answer

Re-,

Effectivement, je blaguais, en parlant du garagiste, car il n'est pas aisé de travailler sur des photos, il est nettement préférable de joindre un fichier exemple (mais au plus près de la structure du fichier réel)

Pour :

Offset(1, 0) : effectivement, prend en compte la cellule située juste en dessous de la cellule de référence (Range("A" & i)), sans décaler de colonne

Resize(10) : redimensionne la cellule en une plage de cellule comprenant les 10 cellules situées les unes en dessous des autres, à partir de la cellule prise en compte (soit E4:E13, par exemple, pour la première boucle)

Bonne soirée