Simplification / correction de code VBA svp
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.
J'ai trouvé, merci pour l'aide.
La solution proposée par Franc fonctionne partiellement. Elle supprime les images existantes s'il y en a mais ensuite ça bugue. Une image est insérée dans la colonne AA et je reçois un message d'erreur. J'ai solutionné le problème en fusionnant une partie de mon code avec celui proposé. Voici donc la version qui fonctionne...
Sub qrcodedevis()
Dim sd As Shape
Dim rng1 As Range, rng2 As Range
Dim x As String, y As String
Set rng1 = Range("P37")
Set rng2 = Range("N50")
' Parcourir toutes les formes sur la feuille active
For Each sd In activeSheet.Shapes
' Vérifier si la forme est située en P37 ou N50 et la supprimer si c'est le cas
If Not Intersect(rng1, sd.TopLeftCell) Is Nothing Or Not Intersect(rng2, sd.TopLeftCell) Is Nothing Then
sd.Delete
End If
Next sd
x = Sheets("Devis HP").Range("U34")
y = Sheets("Devis HP").Range("U36")
' Insérer les nouveaux QR-codes depuis U34 en N50 et depuis U36 en P37
Range("U34").Select
Selection.Copy
Range("N50").Select
activeSheet.Pictures.Insert(x).Select
Range("U36").Select
Selection.Copy
Range("P37").Select
activeSheet.Pictures.Insert(y).Select
Application.CutCopyMode = False
' Sélectionner la cellule U9 (peut être retirée si non nécessaire)
Range("U9").Select
End Sub
Encore un grand merci pour l'aide. Je suis épaté par la rapidité et l'énergie déployés.
Merciiiiiii
