automatisk skiftning af billeder

Dette kan laves vha. VBA. Her er et eksempel på lidt kode, som bør tilrettes dit konkrete behov. Koden indsættes i et modul. Forsidearket hedder her 'Forside' og dataarket hedder 'Data'. Der er ikke i dette
eksempel automatik. Dvs. makroen skal kaldes for hver gang.
Det vil  dog være let at tilrette den, således at den kaldes automatisk, hvis værdien i Worksheets("Data").Range("A2") ændres.

'****************************

Sub IndsætBillede()

Dim billednavn As String

Application.ScreenUpdating = False
Worksheets("Forside").Activate
Range("A6").Select 'Her vil billedet blive sat ind
On Error GoTo Fejl

'Her vælges navnet på billedet. Benyt f.eks. datavalidering
'således at kun navnene 101,102,103,104 mv. kan vælges
billednavn = Worksheets("Data").Range("A2")
'Oplysninger om stien til og navnet på billedet
ActiveSheet.Pictures.Insert("D:\billeder\" & billednavn & ".jpg").Select

'I denne konstruktion vælges billedstørrelse mv.
'Skal givetvis tilrettes.
With Selection
.Left = Range("A6").Left
.Top = Range("A6").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 200#
.ShapeRange.Width = 160#
.ShapeRange.Rotation = 0#
End With

Range("A1").Select
Application.ScreenUpdating = True

Exit Sub

Fejl:
'Giver besked hvis billedet ikke kan findes
MsgBox "Kan ikke finde billedet"
Exit Sub

End Sub

Hej Natkatten

Din kode virker perfekt, men hvordan få man den til at automatisk at køre makroen, når dataen i celle A2 bliver ændret?

En ting til jeg lige har opdaget, hver gang jeg skifter nr. og køre makroen så lægger den bare et nyt billeder ovenpå det gamle. Jeg vi gerne have den sletter det gamle så der altid kun er et billede. Hvordan gør man det?

Ad #2

Du kan benytte denne kode (skal være på det ark, hvor du vælger, hvilket billede, der skal vises). Valget sker i celle A2 (det er denne, der overvåges)
*****************************
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Validering As Range
Set Validering = Range("$A$2")
If Not Intersect(Target, Validering) Is Nothing Then
Call IndsætBillede
End If
End Sub

Ad #3
Hmm, dette oplever jeg umiddelbart ikke. Men prøv at sætte denne linje ind før linjen med ActiveSheet.Pictures.Insert

ActiveSheet.Pictures.Delete

Tak det virker perfekt :) !!!

Send et svar og du får point :)

Fint. Hermed et svar til lukning af spørgsmålet.