Insertion image dans une feuille sans l'intéger au fichier xls

[Vlan71]

Bonjour,
Après des heures de recherches infructueuses, c'est vers vous que je fini par me tourner...

Je cherche à faire afficher dans une feuille excel un fichier image, mais sans que celui ci ne soit intégré dans le fichier *.xls. C'est à dire que excel va "piocher" l'image dans un autre dossier, le chemin de cette image étant dans la cellule A1 par exemple.
Je ne veux pas que cette image soit enregistrée dans le classeur excel pour des raisons de taille de fichier (il devra y avoir au final 300 ou 400 feuilles à mon classeur et une image par feuille...) et aussi pour pouvoir modifier l'image avec un autre logiciel sans avoir à remettre à jour le fichier excel.

Merci à vous !
Vinc.

 

[jp14]

Re : Insertion image dans une feuille sans l'intéger au fichier xls

Bonjour et bienvenue sur le forum

Une piste : utiliser un WebBrowser (WebBrowser1.Navigate)

un exemple sur ce fil
https://www.excel-downloads.com/threads/erreur-avec-webbrowser.124894/



JP

 

[PMO2]

Re : Insertion image dans une feuille sans l'intéger au fichier xls

Bonjour,

Une solution en faisant appel à un UserForm créé dynamiquement pendant l'exécution du code

1) Copiez le code suivant dans un module standard

'###########################################
'#   Ajouter impérativement la référence   #
'#   à partir  de Menu Outils/Références   #
'#                                         #
'#   Library MSForms                       #
'#   C:\WINDOWS\system32\FM20.DLL          #
'#   Microsoft Forms 2.0 Object Library    #
'###########################################

Sub CreeUserForm(myPathName As String)
Dim UF As Object
Dim IM As MSForms.Image
Dim A$
Dim i&
On Error GoTo Erreur
'--- Crée dynamiquement un UserForm ---
Set UF = ThisWorkbook.VBProject.VBComponents.Add(3)    ' 3=UserForm
With UF
  .Properties("Caption") = "Image de " & myPathName
  .Properties("Top") = Application.Top + 20
  .Properties("Left") = Application.Left + 20
  .Properties("Height") = Application.Height - 40
  .Properties("Width") = Application.Width - 40
End With
'--- Crée le contrôle Image ---
Set IM = UF.designer.Controls.Add("forms.Image.1")
With IM
  .Picture = LoadPicture(myPathName)
  .Height = Application.Height - 40
  .Width = Application.Width - 40
  .PictureSizeMode = fmPictureSizeModeClip
End With
'--- Code évènementiel ---
A$ = "Private Sub Image1_Click()" & _
    vbCrLf & "Unload Me" & _
    vbCrLf & "End Sub"
With UF.CodeModule
  i& = .CountOfLines
  .InsertLines i& + 1, A$
End With
'--- Affiche le UserForm ---
VBA.UserForms.Add(UF.Name).Show
'--- Détruit le UserForm ---
Erreur:
If Not UF Is Nothing Then ThisWorkbook.VBProject.VBComponents.Remove UF
If Err = 1004 Then MsgBox "Erreur : " & Err.Number & vbCrLf & _
    Err.Description & vbCrLf & vbCrLf & _
    "Dans Excel faites menu Outils/Macro/Sécurité..." & vbCrLf & _
    "Dans l'onglet Editeurs approuvés cochez 'Faire confiance au projet visual Basic'"
End Sub

2) Copiez le code suivant dans la fenêtre de code de ThisWorkbook

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim A$
Dim rep$
A$ = UCase(Mid(Target, InStrRev(Target, ".") + 1))
If A$ = "BMP" Or A$ = "JPG" Or A$ = "JPEG" Then
  rep$ = Dir(Target)
  If rep$ <> vbNullString Then
    Call CreeUserForm(Target.Value)
    Cancel = True
  End If
End If
End Sub

3) Ajouter impérativement la référence suivante à partir de menu Outils/Références du VBE
Library MSForms Microsoft Forms 2.0 Object Library
C:\WINDOWS\system32\FM20.DLL
4) Dans Excel faites menu Outils/Macro/Sécurité…et dans l'onglet Editeurs approuvés cochez Faire confiance au projet visual Basic
5) Tapez le chemin d'un fichier JPG ou BMP dans une cellule (ex : C:\Documents and Settings\Patrick\Mes documents\Mes images\zaza.jpg)
Si vous double cliquez dans cette cellule, et dans la mesure où le chemin est valide, l'image apparaîtra dans un UserForm.
Il suffit de cliquer dans l'image pour fermer le UserForm.

Cordialement.

PMO
Patrick Morange

 

[Fanfan68]

Re : Insertion image dans une feuille sans l'intéger au fichier xls

Bonjour à tous,

Une autre solution avec un Userform également mais peut-être un peu moins contraignante :

- Tu crée un UF nommé par exemple "Image" que tu mets en ShowModal = False
- Tu y insères un contrôl image nommé par exemple "Image1"
- Dans l'Initialize de ton UF, tu mets le code suivant
Image1.Picture = LoadPicture(ActiveSheet.Range("A1").Value)
- Dans le ThisWorkbook :
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Image.Show
End Sub

Et

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Unload Image
End Sub

Il te reste plus qu'à mettre les chemins complets(C:\mes photos\Toto.jpg....) de tes images dans les cellules A1 de chaque feuille.

Quand tu te balladeras de feuille en feuille, l'UF s'ouvrira avec l'image désirée ou se fermera

A bientôt

 

[Vlan71]

Re : Insertion image dans une feuille sans l'intéger au fichier xls

Bonsoir,

Merci de vos réponses !

J'ai essayé les solutions de jp14 et Fanfan68. (1000 excuses PM02, mais j'ai peur que la votre soit un peu compliquée, surtout en l'utilisant sur plusieurs PC et par plusieurs intervenants avec la référence à ajouter...)

Donc ces solutions fonctionnent parfaitement... sauf que j'avais oublié de préciser que je voulais que l'image s'imprime en même temps que la feuille ! Et malheureusement là ça bloque...

Sinon, je serais plutôt partant pour un userform si cela est possible, afin d'éviter de copier un code dans chaque page. (Je souhaiterais imprimer uniquement l'image, sans la "barre bleue" au dessus : je suis en train de regarder comment la supprimer...)

Merci,
Vinc.


Merci,
Vinc.

 

[Fanfan68]

Re : Insertion image dans une feuille sans l'intéger au fichier xls

Re bonjour tout le monde,

Donc, dans ce cas, on ne va pas passer par un UF mais par la création systèmatique d'une forme automatique dans laquelle nous insèrerons les images.

Cette forme automatique sera créée automatiquement à chaque fois que tu activeras une feuille et sera supprimée automatiquement à chaque fois que tu quitteras une feuille, pour ce faire, tu vas procéder ainsi :

Toujours dans le Thisworkbook :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.ScreenUpdating = False
Range("H5").Select
Pos1 = Range("H5").Left
Pos2 = Range("H5").Top
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 180, 180, 180, 180).Select
Selection.Left = Pos1
Selection.Top = Pos2
Selection.Name = "Image"
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.UserPicture [A1]
Range("H5").Select
Application.ScreenUpdating = True
End Sub

A savoir que :
- Range("H5") est le positionnement de ton image(à modifier selon tes besoins)
-(msoShapeRectangle, 180, 180, 180, 180) est la dimension de ton image(également à modifier selon tes besoins)
-[A1] est la cellule ou tu devras mettre les chemins complets de tes images(également à modifier selon tes besoins)

Et

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Dim ws As Worksheet
Dim shape As shape

Set ws = Sh
ws.Shapes("Image").Delete

End Sub

Voila, j'espère avoir répondu à tes attentes, maintenant, il y aura certainement sur cet excellent forum d'autres personnes qui pourront t'apporter de meileures solutions

A bientôt

Je précise, suite à ce que tu as écrits sur ton post précédent, que tu n'as pas à mettre ces codes dans chaque page mais uniquement dans le ThisWorkbook de ton classeur.

 

[Vlan71]

Re : Insertion image dans une feuille sans l'intéger au fichier xls

Bonsoir,

Merci, c'est super !

Quelques petits soucis néanmoins...

* 1 --
Si jamais la cellule A1 est vide, j'ai un message d'erreur.
J'ai ajouté cette séquence en 3° ligne

Range("A1").Select
If ActiveCell = "" Then Exit Sub

Mais j'ai alors une autre erreur en quittant la feuille sur la ligne -- ws.Shapes("Image").Delete -- puisque cette "image" n'existe pas...

* 2 --
Si le chemin de l'image dans la cellule A1 n'est pas valide (par exemple le *.jpg n'existe pas), j'ai bien évidemment une erreur dont je n'arrive pas à me débarrasser...
Cette seconde erreur est moins importante, mais qui risque de m'arriver un jour... Peut être qu'une solution commune aux 2 soucis est possible, c'est pour cela que je la mets en avant tout de suite.

Si l'un d'entre vous a une idée, je vous en serais très reconnaissant. Mais je ne veux pas abuser de votre temps non plus : j'ai la solution alternative de mettre une image par défaut pour éviter les erreurs intempestives...

Vinc.

 

[Fanfan68]

Re : Insertion image dans une feuille sans l'intéger au fichier xls

Re Re bonjour à tous,

Bon, ça se complique un peu ton histoire....lol

Donc, il va falloire tester si l'image se trouve à l'endroit défini, pour cela dans le "Workbook_SheetActivate(ByVal Sh As Object)" juste au-dessus de la ligne
"Application.ScreenUpdating = False" il faut rajouter :

Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
If FS.FileExists([A1]) = False Then
MsgBox "Chemin absent ou image introuvable à l'endroit défini"
Exit Sub
End If

A savoir que le message ""Chemin absent ou image introuvable à l'endroit défini" peut-être modifié à tes besoins

Et dans le "Workbook_SheetDeactivate(ByVal Sh As Object)" juste au-dessus de la ligne "ws.Shapes("Image").Delete" il faut rajouter :

On Error Resume Next

Voila, cela devrait fonctionner(Ligne à ne pas mettre dans le code....lol)

Bonne journée

 

[Vlan71]

Re : Insertion image dans une feuille sans l'intéger au fichier xls

Bonsoir !
Il n'y a rien a faire, je n'arrive plus à faire planter la macro ! (je rigole, ce n'était pas le but !)
C'est génial, merci !

Je remets le code complet ci dessous pour faciliter la tâche si quelqu'un d'autre est intéresse par la suite.

Encore merci,
Vinc.

--------------

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
If FS.FileExists([A1]) = False Then
MsgBox "Chemin absent ou image introuvable à l'endroit défini"
Exit Sub
End If

Application.ScreenUpdating = False

Range("J9").Select
Pos1 = Range("J9").Left
Pos2 = Range("J9").Top
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 180, 180, 180, 180).Select
Selection.Left = Pos1
Selection.Top = Pos2
Selection.Name = "Image"
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.UserPicture [A1]
Range("J9").Select
Application.ScreenUpdating = True
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)

Dim ws As Worksheet
Dim shape As shape

Range("A1").Select
If ActiveCell = "" Then Exit Sub

Set ws = Sh
On Error Resume Next
ws.Shapes("Image").Delete

End Sub

 

[Vlan71]

Re : Insertion image dans une feuille sans l'intéger au fichier xls

Bonjour à tous !

Je ressors de terre mon sujet qui me pose à nouveau quelques soucis...

La macro fonctionne parfaitement, mais j'observe une perte de qualité de l'image à l'écran et lors de l'impression ! (chose que je n'avais pas remarqué lors de mes tests car je n'avais pas encore créé les fichiers images définitifs...)

Je m'explique : je travaille avec des fichiers gif de 1059*748 pixels (des plans de qualité tout à fait corrects). dans Excel, ces fichiers sont réduit à environ 1/8 de page A4.
=> A l'écran, la qualité du gif dans excel est très médiocre (pixelisation et donc lecture des n° quasiment impossible). Si je zoom à 200 ou 400% : la qualité redevient correcte.
=> A l'impression, j'observe la même perte de qualité que précédemment... Et si je zoom l'affichage avant d'imprimer, la qualité d'impression n'est pas meilleure ! (Ne riez pas, j'ai vraiment essayé, même sans grands espoirs, mais au cas où... lol)

Avez vous une petite idée qui pourrait me dépanner ou bien m'expliquer d'où viens le problème ?
Merci.