Es geht darum Bilder anhand des Namens automatisch einzufügen, dies funktioniert auch bereits. Nun will ich aber noch, dass man den Bereich der Spalte manuell auswählen kann, in der die Namen stehen.

 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

 

Hier der Code der nicht geht, habe das hier verwendet: http://www.supportnet.de/fresh/2005/4/id1049238.asp

 

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