Clever-Excel-Forum

Clever-Excel-Forum > Office-Anwendungen > Excel > VBA Namen von Bildern variable vergebne
Normale Version: VBA Namen von Bildern variable vergebne
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.

K.M.Kay

24.02.2022, 13:12
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

Case

24.02.2022, 14:24
Hallo, 19 

probiere es so: 21 

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

24.02.2022, 15:11
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.

Case

24.02.2022, 16:13
Hallo, 19 

probiere es so: 21 

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

25.02.2022, 08:20
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

25.02.2022, 08:40
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

25.02.2022, 09:08
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

25.02.2022, 12:10
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
 
Clever-Excel-Forum > Office-Anwendungen > Excel > VBA Namen von Bildern variable vergebne