Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
824to828
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
824to828
824to828
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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

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...

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

Betreff
Datum
Anwender
Anzeige
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..
Anzeige
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
Anzeige

212 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige