Bonsoir,
De guerre lasse je me tourne vers vous pour résoudre une énigme sur laquelle je butte depuis 3 heures
J'ai recopié et adapté un code pour mes besoins pour afficher une image dans un pseudo formulaire
Je m'explique
Le "formulaire" n'en est pas un juste une adaptation graphique
Dans le grand carré "Image", je veux par rapport à un code (art-00002) afficher l'image qui correspond et dont le lien apparait en A1
Le pb c'est que la syntaxe "With .Pictures.Insert("ImageLien") obtenu par " ImageLien = Range("A1") " n'est pas correcte et me donne l'erreur suivante.
"Erreur d'exécution '1004' Impossible de lire la propriété Insert dans la classe Picture"
J'ai essayé avec une recherche plus simple sur une autre feuille et en fermant le fichier contenant "Formulaire", cela fonctionne..... A n'y rien comprendre
Pouvez vous m'aider
Merci
moi je dis que ton avatar te va tres bien
ékékecé oulémoncaillé
prend çà et file au lit
j'ai mis un lien a moi en ligne 1 dans Bd pour tester
il faudra que tu remette le bon
ca se fait par formule
la croix vide le formulaire
PoloTaz67
Les images sont destinées aux albums de Tatie Paulette.
Nous, on veut du "couillu"
Du fichier Excel, avec du code VBA dedans!
Donc hop, supprime tes jolies photos et fais péter l'*xlsm, palsambleu!
Trop pressé d'écrire du VBA aussi, peut-être, non ? With .Pictures.Insert(ImaheLien)
Ce serait plutôt ceci qu'on devrait lire, non ? With .Pictures.Insert(ImageLien)
Trop pressé peut être de le recopier, surement aussi.
Mais cela ne change rien au pb le debogeur donne la même erreur que sur l'image de Tatie Paulette (ref PictureInsert) 1° envoi
Chez moi, cela fonctionne
Mais sans doute parce que j'ai supprimé le End Sub (qui est en doublon)
En tout cas, c'est le cas dans le dernier fichier exemple.
Donc une fois, ces corrections effectuées, test OK chez moi
Moi, cela fonctionne aussi comme ceci
(Mais chez moi, en A1, le chemin pointe vers une image qui existe sur mon disque dur)
Est-ce le cas chez toi ?
Ci-dessous ton code modifié à ma sauce (et qui fonctionne pour ce qui concerne l'insertion de l'image)
VB:
Sub AffiheImage()
Dim Imagelien As String, P As Range, f As Worksheet
Set f = Sheets("Formulaire")
With f
Set P = .Range("G4:I18")
On Error Resume Next
.Shapes("MonImage").Delete
On Error GoTo 0
Imagelien = .Range("A1")
If Imagelien = Empty Then
Exit Sub
End If
With .Pictures.Insert(Imagelien)
With .ShapeRange
.LockAspectRatio = msoTrue: .Height = P.Height - 1: .Name = "MonImage"
End With
End With
With .Shapes("MonImage")
.Left = f.[G4].Left: .Top = f.[G4].Top
.IncrementLeft (P.Width - .Width) / 2: .IncrementLeft (P.Height - .Height) / 2
End With
End With
End Sub
NB: Je n'ai fait qu'un toilettage qui réduit un peu ton code
(en utilisant deux variables supplémentaires: f as Worksheet et P as Range
Je n'ai pas touché au reste de ton code
(sauf G4 à la place de F4)
re
bonsoir
le code du demandeur ne prend pas en compte la différence de ratio(range de réception/image)
il es donc erroné même après la correction syntaxique et esthétique par Staple1600
avant de donner ma solution je tiens à dire que le forum est équipé d'un moteur de recherche
la solution qui suit a été donné par moi même moult fois très récemment
il serait pratique de s'en servir
donc
j’extériorise la chose en dehors de la sub dans une autre sub (macro recyclable )
le test empty sur A1 n'est pas suffisant en cas de lien erroné en A1
un test dir fait office de Contrôle général de validité du lien
le nom du sheets parent de la plage est implicite dans la sub opérante
en effet dans la sub appelant "afficheimage" on est dans un blok with/end with et le "." devant " range" indique que la feuille est l'object du block
si la sub opérante devait être utilisée sans blok et sans parent alors "rng.parent"dans celle ci serait la feuille active
donc voici la solution complète que je propose
VB:
Option Explicit
Sub AffiheImage()
With Sheets("Formulaire")
On Error Resume Next
.Shapes("MonImage").Delete
On Error GoTo 0
If Dir(.Range("A1").text) <> "" Then place_l_image_dans .Range("G4:I18"), .Range("A1").Text
End With
End Sub
'
'
Sub place_l_image_dans(rng As Range, chemin As String,Optional nom As String = "Monimage")
Dim Ratio#, W#, H#
With rng.Parent.Pictures.Insert(chemin)
.Name =nom
.ShapeRange.LockAspectRatio = msoTrue ' lock leratio indéformable
Ratio = .Width / .Height ' calcul ratio de l' image
W = rng.Width ' width range
H = rng.Height ' height range
'--------------------------------------------------------------------------------------------
'((((((on a bloqué l'aspect ratio on ne redimensionnera qu'un axe le width ou le height!!!))))
'--------------------------------------------------------------------------------------------
If (W / H < Ratio) Then 'si ratio (rng) < que ratio image alors
.Width = W - 2 'width image=width rng
Else'sinon
.Height = H - (2 / Ratio) ' height image =height rng
End If
.Left = rng.Left + ((rng.Width - .Width) / 2) 'on centre horizontalement
.Top = rng.Top + ((rng.Height - .Height) / 2) ' on centre verticalement
.Placement = 1
End With
End Sub
bonjour a tous voici deux méthode avec exemple pour centrer une image sur un range la méthode que j'appelle directe en effet j'agit directement sur l'image en bloquant l'apect ratio...