Simplification / correction de code VBA

Bonjour.

Je ne suis pas du tout un pro en programmation. Je comprends la base... J'avais besoin de générer 2 QR-codes et qu'ils soient placés en P37 et N50. Dans l'ordre, le code doit :
- supprimer les 2 QR-codes (images) présents en P37 et N50 s'ils existent,
- créer et place les 2 nouveaux QR-codes.

En cherchant beaucoup et par essai/erreur, j'ai concocté ce code :

Sub qrcodedevis()
Dim sd As Shape, rng As Range
Set rng = Range("N50")
For Each s In ActiveSheet.Shapes
If Intersect(rng, s.TopLeftCell) Is Nothing Then
Else
s.Delete
End If
Next s
Dim x As String
x = Sheets("Devis HP").Range("U34")
Range("U34").Select
Selection.Copy
Range("N50").Select
ActiveSheet.Pictures.Insert(x).Select
Dim t As Shape, rngg As Range
Set rngg = Range("P37")
For Each t In ActiveSheet.Shapes
If Intersect(rngg, t.TopLeftCell) Is Nothing Then
Else
t.Delete
End If
Next t
Dim y As String
y = Sheets("Devis HP").Range("U36")
Range("U36").Select
Selection.Copy
Range("P37").Select
ActiveSheet.Pictures.Insert(y).Select
Application.CutCopyMode = False
Range("U9").Select
End Sub

De manière générale, le code fonctionne mais 2 soucis...
1) De temps en temps, le code bugue et me propose le débogage de la ligne suivante :

If Intersect(rng, s.TopLeftCell) Is Nothing Then

Si je rentre dans le débogage, ne change absolument rien et enregistre le code VBA, lorsque je relance la macro, elle fonctionne. Bizare car je n'ai rien changé.

2) Le code duquel je me suis inspiré devait supprimer plusieurs QR-codes se trouvant dans une range. Dès lors, le code utilise la boucle "For each...". Cependant, ne sachant pas comment coder mais comprenant un peu ce qu'il se passe, j'ai supprimé la range concernée par la case qui m'intéressait (P37) et ensuite copié le code pour relancer l'opération pour N50. Il me parait logique que le code n'est pas optimal puisqu'il utilise 2 boucles et que chacune ne traite qu'un seul élément.

En bref, j'aimerais qu'une bonne âme simplifie mon code et fasse en sorte que je n'ai plus de bug intempestif afin que je puisse l'utiliser sans soucis.

Je compte sur votre générosité.

Merci.

Bonjour ComboFab,

Pas testé, car pas de fichier pour le faire :

Un essai de la part de ChatGpt :

Sub qrcodedevis()
    Dim sd As Shape, t As Shape
    Dim rngN50 As Range, rngP37 As Range
    Dim picPath1 As String, picPath2 As String
    Dim sheetDevisHP As Worksheet
    Dim activeSheet As Worksheet

    ' Set references to sheets and ranges
    Set activeSheet = ActiveSheet
    Set sheetDevisHP = ThisWorkbook.Sheets("Devis HP")
    Set rngN50 = activeSheet.Range("N50")
    Set rngP37 = activeSheet.Range("P37")

    ' Get picture paths from the "Devis HP" sheet
    picPath1 = sheetDevisHP.Range("U34").Text
    picPath2 = sheetDevisHP.Range("U36").Text

    ' Delete shapes that overlap with rngN50
    For Each sd In activeSheet.Shapes
        If Not Intersect(rngN50, sd.TopLeftCell) Is Nothing Then
            sd.Delete
        End If
    Next sd

    ' Insert the first picture at rngN50
    If picPath1 <> "" Then
        activeSheet.Pictures.Insert(picPath1).TopLeftCell = rngN50
    End If

    ' Delete shapes that overlap with rngP37
    For Each t In activeSheet.Shapes
        If Not Intersect(rngP37, t.TopLeftCell) Is Nothing Then
            t.Delete
        End If
    Next t

    ' Insert the second picture at rngP37
    If picPath2 <> "" Then
        activeSheet.Pictures.Insert(picPath2).TopLeftCell = rngP37
    End If

    ' Clear the clipboard
    Application.CutCopyMode = False

    ' Select range U9
    activeSheet.Range("U9").Select
End Sub

Bizz

Merci déjà pour le temps consacré. Ca ne fonctionne pas...

Je n'avais pas fourni de fichier car il y avait beaucoup d'infos persos. J'ai créé une version simplifiée sans donnée qui se trouve en pièce jointe. Si j'applique la macro que j'ai créée, ça fonctionne (la plupart du temps). Celle fournie en revanche bugue. J'ai l'impression que la syntaxe est mauvaise au niveau de la déclaration de la variable Sheets("Devis HP"). J'ai essayé de corriger le problème mais il y en a encore d'autres.

A part cela, j'ai l'impression qu'il y a toujours les 2 boucles "For each". Pour le peu que je me rappelle de mes cours de programmation, une boucle n'a de sens que si on traite plusieurs éléments. Ici, on ne traite que 2 éléments et on le fait par 2 boucles. Ca n'a pas de sens je pense. En Français, au lieu de dire :

"Pour chaque élément qui .... il faut le supprimer" et ensuite "ajoute le nouveau QR-code".

il faudrait plutôt dire :

"Si cet élément existe, supprime-le, sinon ne fais rien" et ensuite "ajoute le nouveau QR-code".

Encore merci pour le temps consacré mais malheureusement, le code fourni ne répond à aucune des 2 demandes. Encore merci.

bonjour ComboFab, Bizarre,

je n'ai rien modifié, seulement ajouté 4 petit delais, parce que Excel ne sait pas toujours suivre. Maintenant c'est 250 millisecondes dans la macro "attendre", vous pouvez modifier ce chiffre (diminuer ou agrandir), mais il faut prendre un petit peu de sécurité, pour que çà passe dans 99% des cas.