Anzeige
Archiv - Navigation
1344to1348
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Problem beim Bild einfügen und an Zelle anpassen?

Problem beim Bild einfügen und an Zelle anpassen?
16.01.2014 15:50:20
Kasimir
Hallo an alle!
Mit folgendem Makro füge ich Bilder in eine Exceldatei ein. Allerdings werden die Bilder nicht so ganz eingefügt, wie ich es mir vorgestellt habe. Das Bild soll sich beim Einfügen über das Makro so verhalten, als ob ich es nach dem Einfügen an einem Eckpunkt anfasse und in der Größe verändere. Dabei bleibt ja die Proportion des Bildes erhalten. Leider macht das das Makro nicht.
Sub Bilder_einfuegen()
Dim strPictureName          As String
Dim strPfad                 As String
Dim varPicture              As Variant
Dim varTop                  As Variant
Dim varLeft                 As Variant
Dim varHeight               As Variant
Dim varWidth                As Variant
Dim objBild                 As Object
Dim lngRow                  As Long
Application.ScreenUpdating = False
strPfad = "C:\Bilder\"
For lngRow = 2 To Range("B65536").End(xlUp).Row
varPicture = strPfad & Cells(lngRow, 2) & ".jpg"
'Bild falls vorhanden löschen
On Error Resume Next
ActiveSheet.Shapes(CStr(lngRow)).Delete
On Error GoTo 0
varTop = Cells(lngRow, 1).Top
varLeft = Cells(lngRow, 1).Left
'varHeight = Cells(lngRow, 1).Height
'varWidth = Cells(lngRow, 1).Width
'Bild in Zelle einfügen
Set objBild = ActiveSheet.Shapes.AddPicture(varPicture, _
False, True, varLeft, varTop, varWidth, varHeight)
'Name des Bildes ermitteln
strPictureName = objBild.Name
'Bei dem eingefügten Bild...
With ActiveSheet.Shapes(strPictureName)
'...Name des Bildes ändern
.Name = lngRow
'...Bildproportionen beibehalten
.LockAspectRatio = True
'...die Bildbreite an die Breite der Zelle anpassen
.Width = Cells(lngRow, 1).Width - 4
'...Bildhöhe an die Höhe der Zelle anpassen
.Height = Cells(lngRow, 1).Height * 3 / 4 '- 4
'Breite des Bildes erneut ändern wenn nach Größenänderung noch zu breit
If .Width > Cells(lngRow, 1).Width Then .Width = Cells(lngRow, 1).Width - 4
'Höhe des Bildes erneut ändern wenn nach Größenänderung noch zu hoch
If .Height > Cells(lngRow, 1).Height Then .Height = Cells(lngRow, 1).Height - 4
'...die Position Links an der linken Seite der Zelle ausrichten
.Left = Cells(lngRow, 1).Left + ((Cells(lngRow, 1).Width - .Width) / 2)
'...die Position Oben an der oberen Seite der Zelle ausrichten
.Top = Cells(lngRow, 1).Top + ((Cells(lngRow, 1).Height - .Height) / 2)
End With
Next
End Sub

hat eventuell jemand eine Idee, was ich ändern muss, damit das Bild zwar an die Zelle angepasst wird, aber die Proportion dabei behält?
Danke Euch schon mal,
Kasimir

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem beim Bild einfügen und an Zelle anpassen?
16.01.2014 15:58:52
Rudi
Hallo,
lass beim Einfügen varWidth und varHeight weg.
Sind ja beide 0 und danach sperrst du das Seitenverhältnis!
Gruß
Rudi

Problem beim Bild einfügen und an Zelle anpassen?
16.01.2014 16:15:02
Kasimir
Hallo Rudi!
Danke Dir für Deine Antwort. Die beiden Variablen werden aber scheinbar benötigt. Wenn ich diese bei der Zeile zum Einfügen der Bilder lösche, erhalte ich eine Fehlermeldung.
Wie Sperre ich denn das Seitenverhältnis?
MfG,
Kasimir

denn sie wissen nicht was sie tun.
16.01.2014 16:43:25
Rudi
Hallo,
Wie Sperre ich denn das Seitenverhältnis?
mit LockAspectRatio = True
Weiterhin solltest du, wenn das Seitenverhältnis gesperrt ist, nur eine Dimension ändern.
Sub Bilder_einfuegen()
Dim strPictureName          As String
Dim strPfad                 As String
Dim varPicture              As Variant
Dim varTop                  As Variant
Dim varLeft                 As Variant
Dim varHeight               As Variant
Dim varWidth                As Variant
Dim objBild                 As Picture
Dim lngRow                  As Long
Application.ScreenUpdating = False
strPfad = "C:\Bilder\"
For lngRow = 2 To Range("B65536").End(xlUp).Row
varPicture = strPfad & Cells(lngRow, 2) & ".jpg"
'Bild falls vorhanden löschen
On Error Resume Next
ActiveSheet.Shapes(CStr(lngRow)).Delete
On Error GoTo 0
varTop = Cells(lngRow, 1).Top
varLeft = Cells(lngRow, 1).Left
varHeight = Cells(lngRow, 1).Height
varWidth = Cells(lngRow, 1).Width - 4
'Bild in Zelle einfügen
Set objBild = ActiveSheet.Pictures.Insert(varPicture)
With objBild
'Bei dem eingefügten Bild...
'...Name des Bildes ändern
.Name = lngRow
'...Bildproportionen beibehalten
.ShapeRange.LockAspectRatio = True
'...die Bildbreite an die Breite der Zelle anpassen
.Width = varWidth
'          '...Bildhöhe an die Höhe der Zelle anpassen
'          .Height = Cells(lngRow, 1).Height * 3 / 4 '- 4
'          'Breite des Bildes erneut ändern wenn nach Größenänderung noch zu breit
'          If .Width > Cells(lngRow, 1).Width Then .Width = Cells(lngRow, 1).Width - 4
'          'Höhe des Bildes erneut ändern wenn nach Größenänderung noch zu hoch
'          If .Height > Cells(lngRow, 1).Height Then .Height = Cells(lngRow, 1).Height - 4
'...die Position Links an der linken Seite der Zelle ausrichten
.Left = Cells(lngRow, 1).Left + ((Cells(lngRow, 1).Width - .Width) / 2)
'...die Position Oben an der oberen Seite der Zelle ausrichten
.Top = Cells(lngRow, 1).Top + ((Cells(lngRow, 1).Height - .Height) / 2)
End With
Next
End Sub

Gruß
Rudi

Anzeige
AW: denn sie wissen nicht was sie tun.
16.01.2014 18:12:37
Kasimir
Hallo Rudi!
Leider funktioniert Dein angepasster Code nicht. Du hast den Einfügenbefehl ausgetauscht, was mir aber nichts bringt, da mit Deiner Insert-Methode leider nur Verknüpfungen und nicht die Bilder eingefügt werden. Wenn ich die Datei an jemanden weitergebe, kann die andere Person nicht sehen, da diese Person unter der eingefügten Verknüpfung die Bilder ja nicht hat. Soviel habe ich jedenfalls schon herausgefunden.
Alles andere, also das mit dem Seitenverhältnis hatte ich ja bereits in meinem Code aus meiner Frage, der ja leider nicht so richtig funktionierte.
Noch eine andere Idee?
Danke und Gruß,
Kasimir

Anzeige
Verknüpfung
17.01.2014 10:17:12
Rudi
Hallo,
da mit Deiner Insert-Methode leider nur Verknüpfungen und nicht die Bilder eingefügt werden.
kann ich nicht nachvollziehen.
Ich habe sowohl unter 2003 als auch 2007 mit der Methode ein Bild in eine Exceldatei eingefügt und zur Arbeit gemailt. Das Bild ist da.
Gruß
Rudi

AW: Verknüpfung
17.01.2014 14:26:59
Kasimir
Hallo Rudi!
Wie Du sehen kannst, habe ich als Version 2010 angegeben. In Excel 2010 gibt es daingehend einen Bug, der mit der Insert-Methode nicht die Bilder, sondern nur deren Verknüpfungen einfügt. Wird die Datei auf dem gleichen Rechner geöffnet, fällt das nicht auf, da die Bilder angezeigt werden, da diese ja unter dem Verknüpften Pfad verfügbar sind. Aber auf einem anderen Rechner erscheint anstelle eines Bildes nur ein rotes X. Das alles habe ich schon im Internet recherchiert. Daher die Methode wie in meiner Fragestellung ersichtlich. Allerdings werden die Bilder nicht proportional verkleinert und das ist das Problem, was ich gerne lösen würde. ich weiß nur nicht wie.
Gruß,
Kasimir

Anzeige
AW: Verknüpfung
17.01.2014 14:33:09
Rudi
Hallo,
dann fällt mir als Workaround nur ein, die Bilder per Insert-Methode einzufügen, die Breite und die Höhe auszulesen, das Bild zu löschen und dann wieder per Shapes.AddPicture mit den ermittelten Maßen einzufügen.
Gruß
Rudi

AW: Verknüpfung
17.01.2014 15:56:16
Kasimir
Hallo Rudi!
Das ist es, Danke Dir! Ist sicherlich nicht die feinste Programmierung, aber es funktioniert. Danke nochmal.
Schönes Wochenende,
Kasimir

323 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige