Bild per VBA einfügen und an Zellgröße anpassen

Forumthread: Bild per VBA einfügen und an Zellgröße anpassen

06.12.2006 12:28:23

Boris

Hallo,
hier erstmal ein Bildchen zum besseren Verständnis:
Userbild

Und hier ist der Code, der im Moment die Bilder einfügt, wenn sich in Zelle "F1" etwas ändert:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range("F1")
If Not Intersect(Target, Bereich) Is Nothing Then
On Error GoTo FEHLER
ActiveSheet.Pictures.Delete
ActiveSheet.Cells(3, 6).Select
ActiveSheet.Pictures.Insert(Cells(1, 6).Value).Select
Selection.ShapeRange.ScaleWidth 0.25, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.25, msoFalse, msoScaleFromTopLeft
End If
FEHLER:
Application.EnableEvents = True
End Sub

Nun dazu 2 Fragen:
1) Im Moment werden die Bilder absolut skaliert, d.h. sie müssen alle mit identischen dpi und pixeln abgespeichert sein. Kann man das Bild einfügen und dann die Größe automatisch an die Range("F3:I11") anpassen?
2) Wenn man nun nacheinander verschiedene Bilder in Excel einfügt, dann bleiben diese auch im Speicher bzw. in der Datei, richtig? Mit "Active.Sheet.Pictures.Delete" lösche ich deshalb erstmal alle Bilder, bevor ein neues eingefügt wird. So weit so gut, jedoch gibt es an anderer Stelle des Sheets ein Logo, das damit auch (fälschlicherweise) gelöscht wird :( Wie verhindere ich das?
Fragen über Fragen...

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Bild per VBA einfügen und an Zellgröße anpasse

06.12.2006 12:44:09

Reinhard

Hi Boris,

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$F$1" Then Exit Sub
Dim P
Application.EnableEvents = False
On Error GoTo FEHLER
For Each P In ActiveSheet.Shapes
'anstatt Pict kann es auch Bild o.ä. sein. mit Makro tt ermitteln!
If P.Name Like "Pict*" And P.Name <> "Picture 7" Then P.Delete
Next P
ActiveSheet.Pictures.Insert(Cells(1, 6).Value).Select
With Selection
.Top = Range("F3").Top
.Left = Range("F3").Left
.Height = Range("F3").Height
.Width = .Height * 3 / 4
Range("F3").Width = .Width
End With
FEHLER:
Application.EnableEvents = True
Range("A1").Select
End Sub
Sub tt()
For Each P In ActiveSheet.Shapes
MsgBox P.Name
Next P
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..

AW: Bild per VBA einfügen und an Zellgröße anpasse

07.12.2006 10:36:01

Boris

Hallo Reinhard,
erstmal vielen Dank. Klappt allerdings noch nicht alles so wie es sollte. Das Bild wird zwar in "F3" eingefügt, allerdings wird nicht erkannt, dass die Zellen (Range("F3:I11")) "gemergt" sind, das Bild passt sich deshalb nur an die Zelle F3 an und ist ganz klein. Das "Löschproblem" habe ich deshalb erstmal weggelassen. Hier mein Code (diesmal werden 4 Bilder an unterschiedlicher Stelle eingefügt, und einige Bezüge haben sich geändert):


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$1" Then Exit Sub
On Error GoTo FEHLER
ActiveSheet.Pictures.Delete
ActiveSheet.Pictures.Insert(Range("C1").Value).Select
With Selection
.Top = Range("I9").Top
.Left = Range("I9").Left
.Width = Range("I9:N9").Width
.Height = .Width * 3 / 4
End With
ActiveSheet.Pictures.Insert(Range("D1").Value).Select
With Selection
.Top = Range("I33").Top
.Left = Range("I33").Left
.Width = Range("I33:N33").Width
.Height = .Width * 3 / 4
End With
ActiveSheet.Pictures.Insert(Range("E1").Value).Select
With Selection
.Top = Range("I57").Top
.Left = Range("I57").Left
.Width = Range("I57:N57").Width
.Height = .Width * 3 / 4
End With
ActiveSheet.Pictures.Insert(Range("F1").Value).Select
With Selection
.Top = Range("I81").Top
.Left = Range("I81").Left
.Width = Range("I81:N81").Width
.Height = .Width * 3 / 4
End With
FEHLER:
Application.EnableEvents = True
End Sub

Funktioniert auch soweit, allerdings finde ich etwas umständlich, dass die Breite jedes Bildes manuell direkt im Code festgelegt werden muss, und die Höhe nicht identisch mit der letzten Zeile abschliesst.
Wie löst man das nun also?
Gruß, Boris

Infobox / Tutorial

Bild per VBA einfügen und an Zellgröße anpassen

Schritt-für-Schritt-Anleitung
Häufige Fehler und Lösungen
Alternative Methoden
Praktische Beispiele
Tipps für Profis
FAQ: Häufige Fragen

Schritt-für-Schritt-Anleitung

VBA-Editor öffnen: Drücke ALT + F11, um den VBA-Editor zu öffnen.
Modul einfügen: Klicke mit der rechten Maustaste auf das Projekt, wähle Einfügen und dann Modul.

Code einfügen: Kopiere den folgenden Code in das Modul:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Bereich As Range
   Set Bereich = Range("F1")
   If Not Intersect(Target, Bereich) Is Nothing Then
       On Error GoTo FEHLER
       ActiveSheet.Pictures.Delete
       ActiveSheet.Pictures.Insert(Cells(1, 6).Value).Select
       With Selection
           .Top = Range("F3").Top
           .Left = Range("F3").Left
           .Width = Range("F3:I11").Width
           .Height = .Width * 3 / 4
       End With
   End If
FEHLER:
   Application.EnableEvents = True
End Sub

Anpassen der Zellreferenzen: Stelle sicher, dass die Zellreferenzen im Code deinen Anforderungen entsprechen.
Speichern und schließen: Speichere deine Arbeit und schließe den VBA-Editor.

Häufige Fehler und Lösungen

Bild wird nicht korrekt skaliert: Stelle sicher, dass die Zellen in der Range "F3:I11" zusammengeführt (merged) sind. Ansonsten wird das Bild nur auf die erste Zelle skaliert.
Logo wird gelöscht: Wenn du alle Bilder mit ActiveSheet.Pictures.Delete löschst, wird auch das Logo entfernt. Verwende stattdessen eine Schleife, um nur bestimmte Bilder zu löschen. Beispiel:
```
For Each P In ActiveSheet.Shapes
   If P.Name Like "Pict*" And P.Name <> "DeinLogoName" Then P.Delete
Next P
```

Alternative Methoden

Falls du eine andere Methode bevorzugst, kannst du auch die Funktion VBA Bild in Zelle einfügen und anpassen verwenden. Hier ist ein Beispiel:

Sub BildEinfügen()
    Dim BildPfad As String
    BildPfad = "C:\Pfad\zum\Bild.jpg"

    With ActiveSheet.Pictures.Insert(BildPfad)
        .ShapeRange.LockAspectRatio = msoFalse
        .Top = Range("F3").Top
        .Left = Range("F3").Left
        .Width = Range("F3:I11").Width
        .Height = .Height * 0.75 ' 75% der Höhe
    End With
End Sub

Praktische Beispiele

Hier ist ein Beispiel, wie du mehrere Bilder in Zellen einfügen kannst:

Sub MehrereBilderEinfügen()
    Dim BildPfad As Variant
    Dim ZielZelle As Range

    BildPfad = Array("C:\Bild1.jpg", "C:\Bild2.jpg", "C:\Bild3.jpg")
    Set ZielZelle = Range("F3")

    For i = LBound(BildPfad) To UBound(BildPfad)
        With ActiveSheet.Pictures.Insert(BildPfad(i))
            .Top = ZielZelle.Top + (i * ZielZelle.Height)
            .Left = ZielZelle.Left
            .Width = ZielZelle.Width
            .Height = .Height * 0.75
        End With
    Next i
End Sub

Tipps für Profis

Automatisches Anpassen der Bildgröße: Nutze die Eigenschaft .LockAspectRatio, um die Proportionen des Bildes während der Anpassung zu bewahren.
Bilder dynamisch laden: Verwende die InputBox-Funktion, um den Benutzer nach dem Bildpfad zu fragen.
Fehlerbehandlung: Füge eine umfassende Fehlerbehandlung hinzu, um unerwartete Probleme zu vermeiden.

FAQ: Häufige Fragen

1. Wie kann ich die Größe des Bildes automatisch an die Zelle anpassen? Verwende die .Width und .Height Eigenschaften, um das Bild an die Zellengröße anzupassen, wie im Beispielcode gezeigt.

2. Was kann ich tun, wenn das eingefügte Bild nicht sichtbar ist? Überprüfe, ob das Bild vielleicht hinter anderen Objekten oder Zellen versteckt ist. Stelle sicher, dass die Zellen nicht ausgeblendet oder farblich hervorgehoben sind.

Beliebteste Forumthreads (12 Monate)

Bild per VBA einfügen und an Zellgröße anpassen

Forumthread: Bild per VBA einfügen und an Zellgröße anpassen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Bild per VBA einfügen und an Zellgröße anpassen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

Bild per VBA einfügen und an Zellgröße anpassen

Forumthread: Bild per VBA einfügen und an Zellgröße anpassen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Bild per VBA einfügen und an Zellgröße anpassen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread