VBA Namen von Bildern variable vergebne

[K.M.Kay]

Hei Leute,

ich bin jetzt schon etwas auf google unterwegs gewesen um eine Lösung für mein Problem zu finden.

Und zwar habe ich für Projektdatenblatt einen CommandButton bzw. vier Stück davon.
Beim klicken auf den Button wird der explorer geöffnet und man kann ein Bild auswählen. Dieses wird dann automatisch ander richtigen Stelle eingefügt und skaliert.
Mein Problem ist der Namensbezug des Bildes dieser müsste variabel sein, falls ein Bild gelöscht wird oder man zuerst beim vierten CommandButten ein Bild einfügen möchte.
Desweiteren bräuchte ich hilfe dabei die fehlermeldung loszuwerden wenn man den explorer schließt ohne ein Bild auszuwählen.

Ich hoffe ich konnte einigermaßen verständlich erklären was mein Problem ist.
Und vorab schonmal an alle Danke die mir Helfen können

Mein aktueller Code sieht übrigends so aus.

Private Sub CommandButton1_Click()
ActiveSheet.Unprotect Password:=""
Application.CommandBars.FindControl(ID:=2619).Execute
With ActiveSheet.Shapes("Picture 5")
        .LockAspectRatio = msoFalse
        .Left = [E7].Left
        .Top = [E7].Top
        .Width = [E7:K7].Width
        .Height = [E7:E20].Height
    End With
    ActiveSheet.Protect Password:=""


End Sub

[00202]

Hallo,  

probiere es so:  

Code:

Private Sub CommandButton1_Click()
    Dim lngTMP As Long
    With Me
        lngTMP = .Shapes.Count
        .Unprotect Password:=""
        Application.CommandBars.FindControl(ID:=2619).Execute
        If .Shapes.Count > lngTMP Then
            With .Shapes(.Shapes.Count)
                .LockAspectRatio = msoFalse
                .Left = [E7].Left
                .Top = [E7].Top
                .Width = [E7:K7].Width
                .Height = [E7:E20].Height
            End With
        End If
        .Protect Password:=""
    End With
End Sub

[K.M.Kay]

Vielen Danke, das funktioniert genauso wie ich es mir vorgestellt habe.

---

Hei Case,

Jetzt hab ich nochmal ein Problem festgestellt, könntest du mir da nochmal helfen?
Und zwar sind die ersten beiden Commandbuttons für Bilder im Querformat und die letzten beiden für Hochformat, und die Bilder im Hochformat werden automatisch auf Querformat gedreht und dann in den gewünschten bereich skaliert (sieht blöd aus[img]
Dateiupload bitte im Forum! So geht es: Klick mich!
])
Im Code selber finde ich allerdings kein Befehlt der das auslöst.
Mein Gedanke war dann das ich ein "Rotation" befehl einbaue aber da wird dann das bild ihrgendwo im nirgendwo eingefügt.
Weißt du wie ich das schreiben muss das es funktioniert?

Vielen Dank schonmal im Vorraus.

[00202]

Hallo,  

probiere es so:  

Code:

Private Sub CommandButton1_Click()
    Dim lngTMP As Long
    With Me
        lngTMP = .Shapes.Count
        .Unprotect Password:=""
        Application.CommandBars.FindControl(ID:=2619).Execute
        If .Shapes.Count > lngTMP Then
            With .Shapes(.Shapes.Count)
                .LockAspectRatio = msoFalse
                .Left = [E7].Left
                .Top = [E7].Top
                .Width = [E7:K7].Width
                .Height = [E7:E20].Height
                .IncrementRotation -90
                .Copy
                [E7].PasteSpecial Paste:=xlPasteAll
                .Delete
            End With
        End If
        .Protect Password:=""
    End With
End Sub

[K.M.Kay]

Guten Morgen,
sorry das ich dir erst heute Morgen schreibe, der Code funktioniert nicht ganz.
Das bild wird richitg gedreht und an der richtigen stelle eingefügt. Nur wird das Bild bevor es gedreht wird skaliert und hätte nach dem drehen querformat (siehe Bild im Anhang).
Ich hab probiert den Code so umzustellen das es zuerst gedreht wird und dann skaliert, bin aber gescheitert.
Ich hoffe du weißt mehr.

Danke dir schonmal.

[Kuwer]

Hallo,

vielleicht liegt es daran, dass die Fixierung der Proportionen des Bildes extra aufgehoben wird (warum auch immer).
Ändere mal die Zeile
.LockAspectRatio = msoFalse
in
.LockAspectRatio = msoTrue
um.

Gruß Uwe

[K.M.Kay]

Die Zeile soll das Seitenverhältnis freigeben, damit das Bild in den dafür vorgesehenen Bereich skaliert werden kann.
Damit will ich erreichen das die abstände zu den Bildern immer gleich ist.

Ich hab es natürlich ausprobiert funktionieren tut es nur das die bilder dann über den Bereich gehen und sich dann überlappen.

Aber dennoch Danke

[Kuwer]

Hallo,

Code:

Private Sub CommandButton1_Click()
    Dim lngTMP As Long
    With Me
        lngTMP = .Shapes.Count
        .Unprotect Password:=""
        Application.CommandBars.FindControl(ID:=2619).Execute
        If .Shapes.Count > lngTMP Then
            With .Shapes(.Shapes.Count)
                .LockAspectRatio = msoTrue
                .IncrementRotation -90
                .Left = Range("E7").Left
                .Top = Range("E7").Top
                If .Width / .Height > Range("E7:K7").Width / Range("E7:E20").Height Then
                  .Width = Range("E7:K7").Width
                  .Top = .Top + (Range("E7:E20").Height - .Height) / 2
                Else
                  .Height = Range("E7:E20").Height
                  .Left = .Left + (Range("E7:K7").Width - .Width) / 2
                End If
            End With
        End If
        .Protect Password:=""
    End With
End Sub

Gruß Uwe