Hallo Zusammen,
ich füge über den Dialog "Application.GetOpenFilename(Title:="Bitte Bild auswählen:", FileFilter:="Bilder,*.jpg", MultiSelect:=True)"
ein Bild in die aktive Zelle ein. Der Anwender kann/soll nur ein Bild an dieser Stelle einfügen.
... Auszug aus dem Script
' Bildbreite, Bildhöhe
Dim bildBreite As Integer
Dim bildHoehe As Integer
'Angabe in CentimetersToPoints
bildBreite = Application.CentimetersToPoints(6.5)
bildHoehe = Application.CentimetersToPoints(5.8)
ReDim arrShape(1 To limit)
For index = 1 To limit
Set arrShape(index) = ActiveSheet.Shapes.AddPicture(bildQuelle(index), False, True, ActiveCell.Left, ActiveCell.Top, bildBreite, bildHoehe) ' bei False wird keine Verknüpfung erstellt!
Next index
....
meine Frage: hier gebe ich die bildBreite und die bildHoehe des Bildes mit. Das möchte ich aber nicht so.
Das Bild soll, z.B., in diesen Bereich eingepaßt werden: ActiveSheet.Range("b5:r17").
Wie lese ich die Bildbreite und Bildhöhe des importierten Bildes aus, um dieses dann proportional in das ActiveSheet.Range("b5:r17") einzupassen
If Pic.Width > Pic.Height Then
dann mach das...
End If
If Pic.Width < Pic.Height Then
dann mach das...
End If
Wenn Fragen dann fragen!
Grüße
Andreas
Ich arbeite mit Excel 2019
Hallo Andreas,
hier mal eine Anregung, auf der Du Deine Anpassung aufbauen könntest.
Mit diesem Code kannst Du das Bild sofort einpassen:
Code:
Set AC = ActiveSheet.Range("B5:R17") 'ActiveCell
Set arrShape(Index) = ActiveSheet.Shapes.AddPicture(bildQuelle(Index), False, True, _
AC.Left, AC.Top, AC.Width, AC.Height) ' bei False wird keine Verknüpfung erstellt!
Hier Beispiele zu Deinen Fragen:
Code:
Sub Test()
Dim AC As Range, Index As Integer, arrShape(1) As Object, bildQuelle(1) As String
Index = 0
bildQuelle(Index) = "D:\Pictures\Tierchen\Baby-Rhino.bmp"
Set AC = ActiveSheet.Range("B5:R17") 'ActiveCell
Set arrShape(Index) = ActiveSheet.Shapes.AddPicture(bildQuelle(Index), False, True, _
AC.Left, AC.Top, -1, -1) ' bei False wird keine Verknüpfung erstellt!
If Not arrShape(Index) Is Nothing Then
With arrShape(Index)
If .Width > .Height Then
.LockAspectRatio = msoFalse ' msoTrue 'Bild zerren oder nicht
.Width = AC.Width ' Bild einpassen
.Height = AC.Height
Else
.Left = AC.Left - .Width / 2 + AC.Width / 2 ' Bild im Range einpassen
.Top = AC.Top - .Height / 2 + AC.Height / 2
End If
End With
End If
End Sub
_________
viele Grüße
Karl-Heinz
Hallo Karl-Heinz,
wow, das schau ich mir in Ruhe an. Liest sich schon vielversprechend.
Die Bilder sollen per ActiveCell.Left, ActiveCell.Top platziert werden. Da wo der Anwender den Cursor in der Zelle platziert hat.
Das Hochformatbild im Anhang hat Abmessungen von 1350x2400 und das Querformatbild hat Abmessungen von 2400x1350.
Wie kann ich per VBA das Hochformatbild und das Querformatbild in der Höhe oder Breite des Range-Bereiches skaliert und per ActiveCell.Left, ActiveCell.Top platzieren?
Danke.
Wünsche, dann, ein schönes Wochenende,
Grüße, Andreas
Hallo Andreas,
der Zielbereich sah aber zunächst anders aus: Range("b5:r17")
Daher nachgefragt zu präzisen Aussagen, bzw. diese Fragen musst Du Dir ja auch selbst stellen und festlegen:
- Das Bild kommt in nur ein Feld und zwar das Feld, welches aktuell vom User markiert ist?
- Das Bild kommt nur in den Bereich B5:R17, außerhalb dieses Bereichs kommt kein Bild rein?
- Das Bild wird nicht zentriert sondern links oben in die Ecke des Feldes gesetzt?
- Das Bild wird nicht verzerrt, um damit genau in das Feld zu passen?
- Hochformate werden an die Höhe des Feldes angepasst, Breite ergibt sich automatisch
- Querformate werden an die Breite des Feldes angepasst, Höhe ergibt sich automatisch
Die letzten beiden Festlegung hängen ja auch mit den Feldverhältnissen zusammen, welches ich auch nicht kenne
Im ersten Beitrag wird eine Schleife ausgeführt. Sollen mehrere Bilder in einer Schleife eingefügt werden?
Dann müsste sich ja auch das Einfügefeld ändern, sonst kommen die alle übereinander in ein Feld.
Viele Grüße
Karl-Heinz
Hallo Karl-Heinz, DANKE!
ich habe zwei Bilder angehängt. Zum besseren Verständnis.
Grüße, Andreas
- Das Bild kommt in nur ein Feld und zwar das Feld, welches aktuell vom User markiert ist?
genau, ActiveCell.Left und ActiveCell.Top
- Das Bild kommt nur in den Bereich B5:R17, außerhalb dieses Bereichs kommt kein Bild rein?
siehe Anhang Bild 2
- Das Bild wird nicht zentriert sondern links oben in die Ecke des Feldes gesetzt?
kann = Option, kein Muss
- Das Bild wird nicht verzerrt, um damit genau in das Feld zu passen?
siehe Anhang Bild 2
- Hochformate werden an die Höhe des Feldes angepasst, Breite ergibt sich automatisch
Jupp
- Querformate werden an die Breite des Feldes angepasst, Höhe ergibt sich automatisch
Jupp
Hallo Andreas,
hier ein Code, der ein Bild in den Range
AC (Range) einfügt und entsprechend anpasst.
Falls nach der Breiteneinpassung das Bild wegen der automatischen Höhenanpassung in der Höhe aus dem
AC läuft, wird anschließend nach Höhe eingepasst.
Somit passt das Bild immer ins
AC.
Analog natürlich auch für die Höheneinpassung.
Habe mir erlaubt, je ein Pixel Abstand ggü. dem
AC zu lassen. Finde, sieht besser aus. Kannst Du aber auch gerne wieder weglassen.
Der
AC kann sein:
- die aktuelle Zelle
- ein verbundener Bereich
- ein angegebener Bereich
Code:
Sub Bild_Einfuegen()
' Sub fügt ein Bild in eine Zelle/Bereich ein
Dim AC As Range, Index As Integer, oPic As Object
Dim BildQuelle(1) As String
Index = 0
BildQuelle(0) = "D:\Pictures\DSC_0235.jpg"
BildQuelle(1) = "D:\Pictures\DSC_0242.jpg"
' Bereich setzen, auch verbundene Zellen oder Range
Set AC = ActiveCell.MergeArea 'Range("B5:R17")
' Bild einfügen in linke obere Ecke, Originalgröße
Set oPic = ActiveSheet.Shapes.AddPicture(BildQuelle(Index), _
False, True, AC.Left + 1, AC.Top + 1, -1, -1)
If Not oPic Is Nothing Then
If oPic.Width > oPic.Height Then ' Querformat
oPic.Width = AC.Width - 2
If oPic.Height > AC.Height Then oPic.Height = AC.Height - 2
Else
oPic.Height = AC.Height - 2 ' Hochformat
If oPic.Width > AC.Width Then oPic.Width = AC.Width - 2
End If
End If
End Sub
_________
viele Grüße
Karl-Heinz
Hallo Karl-Heinz,
das sieht schon richtig gut aus. Danke Dir !
Was nicht geschehen soll, ist dass das Bild komplett in eine Zelle platziert wird.
Der Anwender soll, (im Prinzip rein therotisch), irgendwo im Sheet hinklicken (das sind dann die Koordinaten für das Bild = ActiveCell.Top und ActiveCell.Left) können, dort soll dann
das Bild platziert werden, Breite und Höhe angepaßt an diesen Range-Bereich. So wie im Bild "einfügen2.jpg" dargestellt.
Wo wird bei Dir das DSC_0242.jpg platziert? Bei mir gaaaanz weit rechts, bei GB4.
Egal ob ich mit Set AC = ActiveCell.MergeArea (was so nicht gebraucht wird...) oder Set AC = Range("B5:R17") arbeite.
Siehe Bild einfügen3.jpg im Anhang.
Grüße, Andreas
Hallo Andreas,
das Bild wird im Bereich AC platziert und dort in den gültigen Bereich eingepasst.
Das heißt, dass mit Set AC = ActiveCell.MergeArea das Bild im aktiven Feld platziert wird, also dort, wo geklickt wurde.
Oder eben im Bereich B5:R17.
Dass das bei ganz weit rechts sein soll, kann ich nicht nachvollziehen oder Du hast selbst den Cursor dort hingesetzt.
Ist es eine einzelne Zelle, wird das Bild dort eingepasst. Das ist u.U. schlecht, hängt aber auch von Deinem Fehlerabfang ab, ob man da klicken darf.
Ich ging anhand Deiner Bilder von verbundenen Zellen aus. Dann wird das MergeArea gebraucht um das Bild dort über alle verbundenen Zellen einzupassen.
Wenn der User irgendwo klicken kann und dort keine verbundene Zellen sind, ist der Rangebereich immer nur die eine Zelle.
Deshalb kann ich Deinen Ausführungen und auch den Bildern nicht so ganz folgen.
Folgende Möglichkeiten gäbe es noch zum festlegen der AC.
Set AC = Selection => Der User hat selbst einen Range markiert
Set AC = ActiveCell.Resize(5, 5) => Rangebereich immer vom aktiven Feld auf 5 Zeilen, Spalten ausgedehnt.
viele Grüße
Karl-Heinz
Hallo Karl-Heinz,
ich habe jetzt eine Excel-Datei erstellt, siehe Anhang.
Im VBA-Tabellenbereich befindet sich der Quellqode.
Da wo die Zellfüllung gelb ist, setz ich immer den Cursor hin. Dann klicke ich auf den jeweiligen Button.
Querformat funktioniert super.
Hochformat funktioniert leider nicht. Ich habe das Hochformatbild mal so stehen gelassen, wo es eingefügt wird = BM5
Bin ratlos, wo mache ich einen (Denk)Fehler?
Grüße, Andreas
Hallöchen,
Zitat:Der Anwender soll, (im Prinzip rein therotisch), irgendwo im Sheet hinklicken (das sind dann die Koordinaten für das Bild = ActiveCell.Top und ActiveCell.Left) können, dort soll dann
das Bild platziert werden, Breite und Höhe angepaßt an diesen Range-Bereich
Ist "diesen Range-Bereich" immer "B5:R17"? Im Prinzip musst Du dann nur den Code aus #2 etwas anpassen
Code:
Sub Test()
Dim AC As Range, Index As Integer, arrShape(1) As Object, bildQuelle(1) As String
Index = 0
bildQuelle(Index) = "D:\Pictures\Tierchen\Baby-Rhino.bmp"
Set AC = ActiveSheet.Range("B5:R17")
Set arrShape(Index) = ActiveSheet.Shapes.AddPicture(bildQuelle(Index), False, True, _
ActiveCell.Left, ActiveCell.Top, -1, -1) ' bei False wird keine Verknüpfung erstellt!
If Not arrShape(Index) Is Nothing Then
With arrShape(Index)
.LockAspectRatio = msoFalse ' msoTrue 'Bild zerren oder nicht
.Width = AC.Width ' Bild einpassen
.Height = AC.Height
End With
End If
End Sub
Damit sollte das Bild an Position der aktiven Zelle mit der Größe des Bereichs B5:R17 eingefügt werden.