hier der funktionierende Code.
Private
Sub
CommandButton1_Click()
Dim
i
As
Integer
For
i = 2
To
10000
Dim
strpath
As
String
strpath = "C:\Bilder\"
If
ActiveSheet.Range(
"B"
& i).Value > 0
Then
On
Error
Resume
Next
ActiveSheet.Range(
"A"
& i).
Select
Set
Zelle = ActiveCell
If
Not
Dir(strpath & Range(
"B"
& i).Value &
".JPG"
) =
""
Then
Set
Bild = ActiveSheet.Pictures.Insert(strpath & Range(
"B"
& i).Value &
".JPG"
)
With
Bild
.Placement = 2
.Left = Zelle.Left
.Top = Zelle.Top
.Width = Zelle.Height
.Height = Zelle.Height
End
With
End
If
End
If
Next
End
Sub
Private
Sub
Worksheet_SelectionChange(
ByVal
Target
As
Range)
End
Sub
Private
Sub
CommandButton1_Click()
Dim
i
As
Integer
For
i = 2
To
10000
Dim
strpath
As
String
Dim
rngBer
As
Range
strpath = "C:\Bilder\"
Set
rngBer = Application.InputBox _
(prompt:=
"Bereich eingeben oder mit Maus auswählen"
, Type:=8)
If
ActiveSheet.Range(
"rngBer"
& i).Value > 0
Then
On
Error
Resume
Next
ActiveSheet.Range(
"A"
& i).
Select
Set
Zelle = ActiveCell
If
Not
Dir(strpath & Range(
"rngber"
& i).Value &
".JPG"
) =
""
Then
Set
Bild = ActiveSheet.Pictures.Insert(strpath & Range(
"rngBer"
& i).Value &
".JPG"
)
With
Bild
.Placement = 2
.Left = Zelle.Left
.Top = Zelle.Top
.Width = Zelle.Height
.Height = Zelle.Height
End
With
End
If
End
If
Next
End
Sub
Private
Sub
Worksheet_SelectionChange(
ByVal
Target
As
Range)
End
Sub