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
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
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?
15.01.2021, 17:05 (Dieser Beitrag wurde zuletzt bearbeitet: 15.01.2021, 17:05 von volti.)
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.
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
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
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.
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.
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
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.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Bildbreite und Bildhöhe auslesen und übergeben?
