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
- Recherche pour boucle dans une macro VBA
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Recherche automatique des chaînes ne fonctionne pas - Guide
- Comment faire une recherche à partir d'une photo - Guide
- Je recherche une chanson - Guide
- Rechercher ou entrer l'adresse mm - recherche google - Guide
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 If
Cdt
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
Peut-être parce que l'existence du fichier ne garantit pas que l'insertion va bien se passer?
Peut-être mais puisqu'on sait que l'absence de l'image va provoquer systématiquement une erreur, autant éliminer ce cas avec un simple test.