Bilder fest in Excel Dokument speichern

Hallo zusammen, ich bin am rätseln...

und zwar habe ich mit folgendem Programm Bilder automatisiert in Excel eingebunden...

Sub BilderImport()
'
' Bilder werden in die Spalte A eingefügt. Die Bilder werden auf die
' eingestellte Spaltebreite skaliert. Die Zeilenhöhe wird an die
' skalierte Bildhöhe angepasst
'

'* * Dimensionierung der Variablen
Dim strVerzeichnis$, strDatei$
Dim pct As Picture
Dim lngZeile As Long 'Zeile zum Eintragen der Bilder
Dim lngSpalte As Long 'Spalte zum Eintragen der Bilder
Dim varBreite As Variant 'Spaltenbreite
Dim varHoehe As Variant


' Verzeichnis und Dateinamen definieren und auslesen
strVerzeichnis = "F:\Pic"
strDatei = Dir(strVerzeichnis & "\*.jpg")

' Startzeile + Spalte festelegen
lngZeile = 5
lngSpalte = 1

' Ermittlung der Spaltenbreite
varBreite = Columns("A:A").Width

Cells(lngZeile, lngSpalte).Select
Cells(lngZeile, lngSpalte + 1) = strDatei ' schreiben Dateinamen
Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)

With ActiveSheet.Shapes("Picture 1")
' Auslesen der Breite
ActiveSheet.Shapes("Picture 1").Select
Selection.ShapeRange.LockAspectRatio = msoTrue

' Bild auf aktuelle Spaltenbreite skalieren
Selection.ShapeRange.Width = varBreite

' Zeilenhöhe festlegen
varHoehe = ActiveSheet.Shapes("Picture 1").Height
Rows(lngZeile).RowHeight = varHoehe
End With

' Zähler für Shape definieren
shp = 2

' Zeilenzähler erhöhen
lngZeile = lngZeile + 1


' Bild 2 bis n durchlaufen
Do While strDatei <> ""
strDatei = Dir()
If strDatei = "" Then Exit Do
Cells(lngZeile, lngSpalte).Select
Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)
ActiveSheet.Shapes("Picture " & shp).Select
Cells(lngZeile, lngSpalte + 1) = strDatei ' schreiben Dateinamen
Selection.ShapeRange.LockAspectRatio = msoTrue

Selection.ShapeRange.Width = varBreite '* 5.355 'Bild auf Spaltenbreite skallieren

' Zeilenhöhe festlegen
varHoehe = ActiveSheet.Shapes("Picture " & shp).Height
Rows(lngZeile).RowHeight = varHoehe

' Zeilenzähler erhöhen
lngZeile = lngZeile + 1

' Shape-Zahler erhöhen
shp = shp + 1

Loop
End Sub


Sub Sammeln()
' Dimensionierung der Variablen
Dim Höhe As Integer
Dim SHöhe As Single
Dim Breite As Integer
Dim SBreite As Integer
Dim Wert1
Dim strVerzeichnis$, strDatei$
Dim pct As Picture
Dim lngZeile As Long 'Zeile zum Eintragen der Bilder


Höhe = 17
Breite = 5
SBreite = 1
SHöhe = 10
strVerzeichnis = "F:\Pic"
strDatei = Dir(strVerzeichnis & "\*.jpg")

' Startzeile festelegen
lngZeile = 5

Cells(SHöhe, SBreite).Select
'Cells(SHöhe - 1, SBreite) = strDatei ' schreiben Dateinamen
Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei) ' einfügen Bild

With ActiveSheet.Shapes("Picture 1")
ActiveSheet.Shapes("Picture 1").Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 84.75
'braucht nicht da mit LockAspectRatio = msoTrue proportionen beiberhalten werden
Selection.ShapeRange.Width = 113.25
End With

shp = 2

SHöhe = SHöhe + Höhe

Do While strDatei <> ""

strDatei = Dir()

If strDatei = "" Then Exit Do

Cells(SHöhe, SBreite).Select

Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)


ActiveSheet.Shapes("Picture " & shp).Select
Selection.ShapeRange.LockAspectRatio = msoTrue

' Auslesen der Breite
MsgBox Selection.ShapeRange.Width


' Anpassen der Größe
Selection.ShapeRange.Height = 84.75
Selection.ShapeRange.Width = 113.25
shp = shp + 1
'Cells(SHöhe, SBreite + 1) = strDatei
SHöhe = SHöhe + Höhe

If SHöhe >= 65500 Then
SBreite = SBreite + Breite
SHöhe = 2
End If

Loop
End Sub


Alles gut soweit! Nur werden die Bilder als Link abgespeichert. Das heißt liegen die Bilder im Netzwerk ist das Excel Dokument nicht zu gebrauchen.

Wie bekomme ich die Bilder in der Datei abgespeichert ??

THX for Help

for each cell in Selection.Cells
    'hier gehts weiter mit cell.Value als Wert jeder Zelle der Auswahl.  
Next