Hent billede og vis i regneark

For bedre at forstå dig.
Du vil have et lille billede i kolonne L.
Når du klikker på det lille billede ser man webadressen/et større billede ?

qpc

Ja, jeg vil gerne have vist det billede som der er en direkte link til i kollonnen (bare som en lille thumbnail)
Dette billede skal være klikbart og henvise til det store billede på nettet.

Prøv.
Hent billedet, placer det eventuelt på skrivebordet.
Indsæt det i den rigtige celle i kolonne L.
Formindsk det, så det er inde i cellen.
Indsæt hyberlink/webadresse i billedet.

qpc

Jo det kunne jeg nok godt gøre, men jeg har en liste med ca. 1000 varer hvor adressen allerede står, så findes der ikke en måde hvorpå den selv kan hente billederne ind i kollonnen via dette link?

Det var jo noget andet.
Så det, vil jeg overlade til andre.

Venlig hilsen
qpc

Billede indsættes i en kommentar i B2:B1000 - ret i linie 3 hvis
det skal være et andet sted
Der indsættes XXX i cellerne, men kan også ændres til en tekst i en anden kolonne, eller evt. selve link-teksten...

Sub HyperTest()
On Error Resume Next
Set rng = Range("B2:B1000")
For Each c In rng
c.Select
If Cells(c.Row, "L") <> "" Then
Selection.AddComment
Selection.Comment.Visible = True
Selection.Comment.Shape.Select True
Selection.ShapeRange.Fill.UserPicture Range("L" & c.Row).Value
c.Comment.Visible = False
c.Select
c.Formula = "=HYPERLINK(L" & c.Row & "," & """XXX""" & ")"
End If
Next
End Sub

Rigtigt flot :-)

MEN kan det lade sig gøre at den viser billederne i stedet for xxx?
Altså ikke kun ved "mouse over" men alle billeder hele tiden?

Går ud fra du har adresser i alle rækkerne, som følge af dette indsættes linkbilledet i kolonne B i alle rækker med adresse i L
Koden skalerer billedernes højde efter rækkehøjden
Så har du standard-rækkehøjde 13.2 bliver det godt nok småt.

Sub HyperBillede()
On Error Resume Next
Set rng = Range("B2:B1000")
For Each c In rng
c.Select
If Cells(c.Row, "L") <> "" Then
With ActiveSheet.Pictures.Insert(Range("L" & c.Row), ActiveSheet.Range("B" & c.Row))
.Width = ActiveSheet.Range("B" & c.Row).ColumnWidth * 2.8
.Height = ActiveSheet.Range("B" & c.Row).RowHeight
ActiveSheet.Shapes(.Index).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=ActiveSheet.Range("L" & c.Row)
End With
End If
Next
End Sub

*** ("L" & c.Row) *** hører til linien ovenover

hvordan går det ?

?

undskyld jeg ikke vente tilbage tidligere, men jeg havde helt glemt det.
Sorry.

Jeg får ikke rigtigt det resultat jeg søger, da jeg gerne vil ahve at alle billederne sættes ind med det samme, så man kan se dem hele tiden?
Men jeg accepterer dit svar med det samme så jeg ikke glemmer det igen :-)

Tak for hjælpen.

fik vi denne gjort færdig ?