Recherche pour boucle dans une macro VBA
RésoluRoMa -
Bonjour,
N'ayant jamais codé en VBA j'ai un peu de mal à comprendre comment intégrer une boucle au sein d'une macro dont j'ai besoin.
Ayant été à la recherche d'une solution permettant d'insérer des images dans un fichier Excel, j'ai mis la main sur la macro suivante:
Sub LinkToImage()
For Each cel In Selection
cel.Offset(0, 2).Select
cel.Offset(0, 2).RowHeight = 100
cel.Offset(0, 2).ColumnWidth = 40
Set image = ActiveSheet.Pictures.Insert(cel.Value)
With image
.ShapeRange.LockAspectRatio = msoTrue
.Width = cel.Offset(0, 2).Width
.Height = cel.Offset(0, 2).Height
.Left = cel.Offset(0, 2).Left
.Top = cel.Offset(0, 2).Top
End With
Next cel
End Sub
Cette dernière fonctionne à merveille quand la photo recherchée existe bel et bien mais, au moindre manque la macro s'arrête.
Comment faire pour passer à la case suivante si la photo recherchée est manquante ou mal nommée?
J'ai bien essayé d'intégrer une boucle Si mais je n'arrive pas à trouver comment rédiger quelque chose de fonctionnel.
Je vous remercie par avance pour toute l'aide que vous pourrez m'apporter.
Cordialement,
Marc
Windows / Chrome 109.0.0.0
4 réponses
-
Bonsoir,
Pourquoi ne pas tout simplement tester l'existence du fichier avant de faire l’insertion :
If Dir(cel.Value) <> "" Then ' Si le fichier existe Set image = ActiveSheet.Pictures.Insert(cel.Value) With image .ShapeRange.LockAspectRatio = msoTrue .Width = cel.Offset(0, 2).Width .Height = cel.Offset(0, 2).Height .Left = cel.Offset(0, 2).Left .Top = cel.Offset(0, 2).Top End With End IfCdt
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
bonjour,
j'imagine que la macro s'arrete avec un message d'erreur?
quand tu partages du code, merci de tenir compte de ceci: https://codes-sources.commentcamarche.net/faq/11288-poster-un-extrait-de-code
Suggestion pour continuer en cas d'erreur:
Sub LinkToImage() For Each cel In Selection cel.Offset(0, 2).Select cel.Offset(0, 2).RowHeight = 100 cel.Offset(0, 2).ColumnWidth = 40 on error goto suivant Set image = ActiveSheet.Pictures.Insert(cel.Value) With image .ShapeRange.LockAspectRatio = msoTrue .Width = cel.Offset(0, 2).Width .Height = cel.Offset(0, 2).Height .Left = cel.Offset(0, 2).Left .Top = cel.Offset(0, 2).Top End With suivant: on error goto 0 Next cel End Sub
-
Bonjour yg_be,
Merci beaucoup pour votre remarque concernant le partage des codes.
Je tenais également à vous remercier pour votre idée de l'ajout de la fonction "on error go to".
Malheureusement le message d'erreur 1004 continue de revenir en cas d'absence de la photo cherchée sous prétexte qu'il est : "Impossible de lire la propriété Insert de la classe Pictures."
Cordialement,
Alex
-
plutôt ainsi:
Sub LinkToImage() For Each cel In Selection cel.Offset(0, 2).Select cel.Offset(0, 2).RowHeight = 100 cel.Offset(0, 2).ColumnWidth = 40 on error goto oups Set image = ActiveSheet.Pictures.Insert(cel.Value) With image .ShapeRange.LockAspectRatio = msoTrue .Width = cel.Offset(0, 2).Width .Height = cel.Offset(0, 2).Height .Left = cel.Offset(0, 2).Left .Top = cel.Offset(0, 2).Top End With suivant: on error goto 0 Next cel Exit Sub oups: Resume suivant End Sub
-
-
Bonjour yg_be,
Merci beaucoup pour votre nouveau message. Tout est à présent parfait !
Pour ne pas trop vous prendre de temps je vais regarder de mon côté afin de comprendre comment votre ajout fonctionne.
Bonjour RoMa,
Merci également pour votre aide. je vais également essayer votre code.
Cordialement,
Marc
