XL 2019 Copier une zone de texte à intervalle régulier

[thespeedy20]

Bonjour le Forum,

J'ai une zone de texte dans une cellule(A2), le nombre de répétition en B2... dans la feuille Shape, j'aimerais copier cette zone de texte à intervalle régulier(ex: toutes les 50lignes) dans la feuille copie.

Pour l'instant j'arrive à faire la copie avec la macro suivante mais j 'ai décalage entre les zones de texte... J'aimerais aussi pouvoir changer la cellule de départ

J'ai un bouton sur la feuille shape pour la copie, quand je l'utilise les shapes ne sont copiés au bon endroit, si je suis dans l'éditeur, c'est copié au bon endroit avec décalage

Sub Copiexfois()

Dim r As Range, sh As Shape, shCopy As Shape, i As Long, nCol As Long
Dim nRow As Long, j As Long, ctr As Long

nCol = 1

Application.ScreenUpdating = False

For Each sh In Worksheets("Copie").Shapes
    sh.Delete
Next sh

For Each r In Worksheets("Shape").Range("B2", Worksheets("Shape").Range("B" & Rows.Count).End(xlUp))
    For Each sh In Worksheets("Shape").Shapes
        If Not Intersect(sh.TopLeftCell, r.Offset(, -1)) Is Nothing Then Exit For
    Next sh
    For i = 1 To r.Value
        ctr = ctr + 1
        sh.Copy
        With Worksheets("Copie")
            DoEvents
            .Paste
            Set shCopy = .Shapes(.Shapes.Count)
            If ctr Mod nCol = 1 Then
                j = 0
                nRow = nRow + 1
            End If
                        
            shCopy.Top = j * (Cells(j + 50, 1).Top) '20 distance entre shapes
            shCopy.Left = Cells(1, 5).Left
            
            j = j + 1
        End With
    Next i
Next r

Application.ScreenUpdating = True

End Sub

Merci d'avance pour votre aide

OLi

 

[Phil69970]

Bonjour @thespeedy20

Je te propose ce fichier

Tu as le choix entre 2 sortent de copies
1) 1 copie avec les données de la copie sont inscrit en dur dans le code VBA
OU
2) 1 copie entièrement paramétrable tout est réglable :
- La colonne de copie dans la feuille "copie"
- Le nombre de ligne entre la copie dans la feuille "copie"

*Merci de ton retour

@Phil69970

 

[thespeedy20]

Bonjour Phil69970, le forum

Merci pour ta proposition, cela fonctionne très, l'outils paramétrable est génial, je vais même ajouter le départ de ligne en paramètre, j'ai ajouté également une boucle pour effacer les shapes lors de nouveaux paramètres.

J'ai aussi de temps à autre une erreur 400, je fais ok, je recommence et cela fonctionne...Bizarre

Petite question , j'ai un petit logo à mettre en regard du texte, il y a t-il possibilité de l'inclure et de pouvoir paramétrer l'écartement entre les deux ?

Je te remercie encore une fois pour ton aide

OLi

 

[Phil69970]

@thespeedy20

Je te propose cette version

Pour l'erreur 400 j'ai l'impression quelle vient lorsque la copie d'une forme n'a pas le temps de finir et qu'une autre copie commence mais sans garantie

*A priori si on met les 2 formes dans la même cellule il se superpose donc j'ai mis le logo dans la cellule d'avant
On pourrait faire le contraire commencer par coller le logo et après dans la colonne suivante coller le "Test de copie" ce qui permet de supprimer le message ou bien le laisser si il n'y a pas de lettre dans la cellule F2

Je te laisse t'amuser à faire des essais j'ai commenté un peu le code donc tu devrais y arriver sans trop de problème

Merci de ton retour

@Phil69970

 

[Phil69970]

@thespeedy20

Allez je l'ai fait je le poste

*Merci de ton retour

@Phil69970

 

[thespeedy20]

@Phil69970,

- Pas de soucis, je sais inverser le logo et le shape(texte) et leur donner la bonne position

-Très bonne idée si pas de colonne sélectionnée, de mettre la col A par défaut

- Par contre toujours erreur 400, alors j 'ai copié ton code dans un module, là j'ai eu une erreur de paste, j'ai du mettre un DoEvents avant et là plus erreurs... du moins pour l'instant

- voici donc mon retour... je reviens vers toi si j'ai d'autres soucis à l'utilisation ou d'autres idées. Encore Merci

OLi

 

[Phil69970]

@thespeedy20

j 'ai copié ton code dans un module

Pourquoi mettre le code dans un module alors que dans mon fichier il n'est pas dans un module !!!
Si tu veux le mettre dans ton fichier mets le correctement ET au même endroit sinon tu risques d'avoir des erreurs.
Mon fichier du post #4 ou tu post #5 ne bug pas (en tout cas je ne suis pas arrivé à faire le bug) donc copie le tel quel et tu verras que cela fonctionneras dans ton fichier.
Normalement avec les commentaires que j'ai mis tu ne devrais pas avoir de problème d'adaptation sinon poste ton fichier en l'anonymisant.

Le fichier du post #5 fait les choses dans l'ordre ==> copie du logo puis copie du test de copie à droite et il me semble plus judicieux.

*Merci de ton retour

@Phil69970

 

[thespeedy20]

@Phil69970

Suite, aux erreurs 400, j'ai regardé sur le net, afin de plus en avoir...il proposait de mettre le code dans un module... j'ai essayé et cela a fonctionné... loin de moi l'idée de te contrarier...

Effectivement , je privilégie le fichier du poste #5

Ici je suis sur mon portable en 64 bit(Office 2021), erreur 400 sans arrêt... j'essayerai plus tard sur mon pc fixe (32 bit - Office 2019) car j'ai été opéré au genou, et je ne sais pas monter les escaliers... pour l'instant.


OLi

 

[Phil69970]

Le fil

loin de moi l'idée de te contrarier.

Cela ne me contrarie pas mais j'ai l'impression que cela te génère plein d'autre erreur.

Perso j'ai excel 2010 - 64 bits et j'arrive pas à le faire buguer !

1) As tu d'autres fichier excel ouvert ?

2) Comment tu arrives au bug ? (Exemple : Je fais ci ou ça , je clique sur la cellule x etc....)

3) Poste ton fichier anonymisé

@Phil69970

 

[thespeedy20]

@Phil69970,

Je viens de désinstaller une des dernières mise à jour de Windows, relancer le PC
et là miracle plus d'erreur 400 et code laissé dans la feuille , ouf...tous fonctionne sans aucun soucis, je change les paramètres dans tous les sens et la copie se fait...


OLi

 

[Phil69970]

Re

Super donc le fichier fonctionne.
Il te reste à valider la solution que tu as retenue.

@Phil69970

 

[thespeedy20]

re,

Encore Merci pour ton aide et ta patience @Phil69970

@+

OLi