jinzumia
Goto Top

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 face-smile

Content-Key: 368678

Url: https://administrator.de/contentid/368678

Ausgedruckt am: 19.03.2024 um 07:03 Uhr

Mitglied: Meierjo
Meierjo 20.03.2018 um 18:02:06 Uhr
Goto Top
Hallo

Ein bisschen Googeln bringt dich auf diese Seite.
Hier steht, dass deine Einfügemethode "veraltet" ist, und ab Excel 2010 die Bilder als Verknüpfung einfügt.

Der Code, mit welchem due die Bilder richtig importierst, steht auch dort.

Gruss
Mitglied: Jinzumia
Jinzumia 21.03.2018 um 10:44:47 Uhr
Goto Top
Danke schonmal für den ersten Hinweis.

Bekomme es aber nicht zum Laufen ...
pfad
Mitglied: colinardo
colinardo 21.03.2018 um 14:17:34 Uhr
Goto Top
Tipp: Doppelt gemoppelter Backslash face-smile.

Grüße Uwe
Mitglied: Jinzumia
Jinzumia 21.03.2018 um 14:59:23 Uhr
Goto Top
Ach jo habs dann auch gesehen.

Problem.. Datei wird trotzdem nicht gefunden ... argh
Mitglied: Jinzumia
Jinzumia 21.03.2018 um 15:35:45 Uhr
Goto Top
Kurze Info:

gebe ich es so ein:

ActiveSheet.Shapes.AddPicture _
"C:\Bilder\1010213.png", _
False, True, 100, 100, 70, 70

geht es.
Mitglied: colinardo
colinardo 21.03.2018 aktualisiert um 18:36:25 Uhr
Goto Top
Zitat von @Jinzumia:

Ach jo habs dann auch gesehen.

Problem.. Datei wird trotzdem nicht gefunden ... argh
Kein Wunder dein Range rw verweist ja auf eine ganze Row nicht nur auf eine Zelle face-smile.
for each cell in Selection.Cells
    'hier gehts weiter mit cell.Value als Wert jeder Zelle der Auswahl.  
Next