Bilder immer mit gleicher Größe einfügen

[Kuwer]

Hallo Daniel,

@Uduuh
Ja, wenn die Zielfläche ein Quadrat ist, kann man es so machen wie du es gezeigt hast.
Wenn nicht, so wie von mir beschrieben.

ich dachte, Deine Beschreibung bezog sich auf Udos Code, denn genau so arbeitet der.

Gruß, Uwe

[Uduuh]

Hallo,
geht auch mit einer nicht quadratischen Zielfläche. Egal ob das Bild hochkant oder quer ist.

Gruß aus'm Pott
Udo

[Uduuh]

Hallo,
komplett so:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    '
    Dim rngZiel As Range
    Dim ImportBildName As String
    Dim myPic
    Dim InI As Integer
    ActiveSheet.Unprotect
    Application.ScreenUpdating = False
   
    If Target.Address = "$D$1" Then
        Set rngZiel = Range("a2") ' Zielzelle festlegen
        For InI = ActiveSheet.Shapes.Count To 1 Step -1
            If ActiveSheet.Shapes(InI).TopLeftCell = rngZiel Then
                ActiveSheet.Shapes(InI).Delete
            End If
        Next InI
       
        ImportBildName = "C:\Users\.....\Bilder\Bilder Original\" & Range("d1").Value & ".jpg" ' Dateiname zusammenstellen
        If Dir(ImportBildName) = "" Then
            MsgBox "Bild nicht vorhanden!", vbCritical, "gebe bekannt..."
            Exit Sub
        End If
       
        Set myPic = ActiveSheet.Pictures.Insert(ImportBildName)
       
        With myPic
            .ShapeRange.LockAspectRatio = True
            If .Width > .Height Then
                .Width = rngZiel.Width
                .Height = Application.Min(.Height, rngZiel.Height)
            Else
                .Height = rngZiel.Height
                .Width = Application.Min(.Width, rngZiel.Width)
            End If
            .Left = rngZiel.Left + (rngZiel.Width - .Width) / 2
            .Top = rngZiel.Top + (rngZiel.Height - .Height) / 2
        End With
       
        Application.ScreenUpdating = True
        ActiveSheet.Protect
    End If
End Sub

Gruß aus'm Pott
Udo

[slowboarder]

Hallo,
So im Prinzip, kannst du das selber programmieren?
Muss er nicht. Alles in meinem Code enthalten. Nur einfacher

Gruß aus'm Pott
Udo

Hallo,
geht auch mit einer nicht quadratischen Zielfläche. Egal ob das Bild hochkant oder quer ist.

Gruß aus'm Pott
Udo

Dann ist es aber nicht mehr einfacher, weil du 2x die Größe anpasst statt nur 1x und dann noch komplexe Auswertefunktionen (Min) verwendest. Du brauchst auch nicht weniger Zugriffe auf die Objekteigenschaften

Wenn einfach, dann so

MyPic.Width = rngZiel.Width
If MyPic.Hight > rng.Ziel.Hight then MyPic.Height = rngZiel.Height

[schauan]

Hallöchen,

Code:

MyPic.Width = rngZiel.Width
If MyPic.Hight > rng.Ziel.Hight then MyPic.Height = rngZiel.Height

Wenn die Breite kleiner oder gleich der Zellbreite ist, braucht man es nicht breiter zu machen ...
(bei kleiner, sofern der TE das Bild nicht vergrößern will, falls es kleiner als die Zelle sein kann).

Du würdest die Größe ggf also auch 2x ändern, zumindest aber 1x .. Wenn man's wüsste, könnte man die Änderung auf 0 reduzieren.

Mit Min kannst Du auf die If verzichten. Klar, jetzt könnte man über die Performance von If und Min diskutieren. Oder über die Übersichtlichkeit von Code - ok, da könnte der Geschmack reinspielen

Genau genommen ist aber beides an der Aufgabe vorbei. Wenn alle Bilder die gleiche Größe haben sollen, müsste man mit den (vorgegebenen) Werten arbeiten, also einfach nur

Code:

.ShapeRange.LockAspectRatio = False
.Height = 213 ' Bildhöhe
.Width = 213  ' Bildbreite

[slowboarder]

ich hatte in meinem ersten Lösungsvorschlag ja beschreiben, wie man herausfindet, welchen Wert man anpassen muss, so dass man mit einer einzigen Größenänderung auskommt.
Das wurde von Uduuh aber als kompliziert beschrieben.

mein zweiter Vorschlag mit dem nachgestellten IF hat die Folge, dass die Größe nur manchmal 2x geändert wird, aber nicht immer.
bei der Verwendung von MIN wird immer 2x geändert.

bei deinem Vorschlag wird das Bild u.U. verzerrt, wenn die Größenverhältnisse voneinander abweichen. Das ist häufig aber unerwünscht.

[schauan]

@snowboarder,

alles gut, wir sind uns doch einig ... die Aufgabe war

Bilder immer mit gleicher Größe einfügen

und daran wollte ich nur mal erinnern ...

Wenn ich z.B. an meine MP3 denke, sind die Bilder dort immer quadratisch ... Wenn ich da mal welche habe, wo das nicht der Fall ist, schneide ich die zu, bevor ich sie quadratisch praktisch frisch einfüge. Irgendwelche inhaltlosen Streifen mag ich da nicht.

Das mit der Verzerrung ist eigentlich schon Faust zweiter Teil und wie das gehen kann haben wir ja nun alle gezeigt ... Ist aber eben nicht nötig bei quadratischen Voraussetzungen.

[slowboarder]

ja, du gehst halt wieder mal nur von dir selber aus und denkst, dass alle anderen das auch so mache wie du
ich arbeite nie mit MP3 und auch nie mit Bildern, die immer quadratisch sind.

und weil du vorhin gefragt hattest nach dem Unterschied zwischen MIN und IF zur Ermittlung des kleineren Wertes.
hab mal nen Testlauf gemacht mit 1 Million vergleiche:
IF-THEN: 0,02 sec
MIN: 4 sec

klar, für diese Aufgabe irrelevant, aber du hattest gefragt.

[schauan]

... oh, was unterstellst Du mir denn da ...

ich versuche in der Regel, mich auf die Aufgabe zu konzentrieren und eine Motivation des Aufgabenstellers dahinter zu erkennen, auch wenn das nicht immer optimal ist. Ich versuche dann, dafür eine Lösung anzubieten - auf das LockAspectRatio hatte ich bereits in #2 verwiesen - und auch eine Alternative aufzuzeigen - ebenfalls in #2.

Ob das passt, sei dahingestellt - ich kenne ja seine Datei nicht und weiß auch nicht, ob er nur quadratische Bilder hat.
Ich behaupte auch nicht, dass meine Lösungen das Gelbe vom Ei sind.

Mit quadratischen Bildern bin ich sicher nicht der einzige. Ich habe noch Fotos aus Oma's Zeiten, die sind auch quadratisch. Ich kann mir auch vorstellen, dass Bilder von Mikroskopen oder Teleskopen quadratisch sinnvoll sind. Würfel von der Seite, Kreise, Kugeln, Bälle, kann man alles in quadratischen Bildern darstellen. Verkehrsschilder, Icons, Thumbnails auf vielen Seiten, der Phantasie sind keine Grenzen gesetzt...

   
Der Kleine bin ich, dürfte so etwa 1962 gewesen sein. Meine Tante hatte damals 2 IFA F8, eine Limousine und einen Kombi.

Ich tue nicht davon ausgehen, dass alle das so machen wie ich, sondern ganz das Gegenteil ... Ok - aktuell hat sich Klaus-Dieter positiv über meine Vorgehensweise beim Umbenennen von Fotos geäußert. Aber ich schreibe ihm das doch auch nicht vor.

Ich habe übrigens nur erwähnt, dass man über die Performance diskutieren kann. Würde ich davon nix wissen, hätte ich das sicher nicht erwähnt.
Ist aber schön, hier Dein Testergebnis zu sehen.

Falls er nur quadratische Bilder hat, ist sicher weder If noch Min noch sonst eine Prüfung nötig, sondern eben nur die Änderung. Weiß ich aber auch nicht.

[Karlheinz16]

Hallo Freunde,

vielen Dank für eure Bemühungen. Ich habe das, was ich am Besten testen konnte, übernommen. Meine Wahl viel auf Uduuh. Die anderen Möglichkeiten konnte ich zum Teil nicht so umsetzen, wie es für mich optimal gewesen wäre. Mittlerweile glaube ich, ich habe mich nicht richtig ausgedrückt, für das Bild das eingefügt werden soll steht ein Platz von 71,14 x 238 zur Verfügung. Für mich war wichtig, dass das Bild in diesen Rahmen passt, wobei die Seitenverhältnisse beibehalten werden sollen. Und genau das bewältigt der Code von Uduuh.