Bilder hinzufügen, verkleinern und ersetzen

[Deko]

Servus Zusammen,

hoffentlich eine kurze Frage ;D

Ich habe eine Liste mit insg. 4 "Bild-Feldern".

siehe Screenshot (2 abgebildet):



Das die Bilder über die Schaltfläche daneben eingefügt werden habe ich hinbekommen.

Relativ simpel:

Code:

Sub Bild1()
Dim varBild As Variant
   Dim objImg As Object
   varBild = Application.GetOpenFilename(Title:="Test")
   If varBild = False Then Exit Sub
   With Tabelle1.Image1
       .PictureSizeMode = fmPictureSizeModeStretch
       .Object.Picture = LoadPicture(varBild)
   End With
End Sub

Sub Bild2()
Dim varBild As Variant
   Dim objImg As Object
   varBild = Application.GetOpenFilename(Title:="Test")
   If varBild = False Then Exit Sub
   With Tabelle1.Image2
       .PictureSizeMode = fmPictureSizeModeStretch
       .Object.Picture = LoadPicture(varBild)
   End With
End Sub

Jetzt bräuchte ich das ganze aber so, dass die Bilder nicht in Originalgröße eingefügt werden. Wenn ich aktuell ein 5MB Bild einfüge, wird die Datei direkt um 5 MB Größer.

UND Wenn ich z.B. an der ersten Stelle dann ein anderes Bild einfüge, wird das alte nicht gelöscht, dann habe ich schon 10 MB mehr.

Cool wäre dafür ein Button zum löschen, ODER was mir besser gefallen würde, immer wenn ich ein neuen Bild hinzufüge, wird das alte gelöscht.

Hoffe ihr könnt mir helfen

p.s.

Zusatzaufgabe (aber nicht so wichitg) Die Mappe erste speichern können wenn mindesten Bild 1-3 eingefügt sind.

Aktuell löse ich das über die gelbe Zelle daneben, wenn da nichts als Bild Beschreibung drin ist kann nicht gespeichert werden:

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   Dim c As Range
 
   For Each c In Worksheets("prüfprotokollnsw").Range("O289,O303")
       If c = "" Then
           MsgBox "Bild Typenschild & Metrologie-Kennzeichnung, sowie Bild Sicherungsmarke(n) muss eingefügt und im gelben Feld ausgewählt sein!"
           Cancel = True
           If Range("O289") = "" Then Range("O289").Activate
           If Range("O303") = "" Then Range("O303").Activate
           Exit For
       End If
   Next c
End Sub

[RPP63]

Verlinkst Du bitte die Beiträge in den Foren untereinander?
Nicht, dass sich ansonsten jemand unnütz Arbeit für Dich macht …

[schauan]

Hallöchen

Jetzt bräuchte ich das ganze aber so, dass die Bilder nicht in Originalgröße eingefügt werden.

Excel ist keine Bildverarbeitung. Wenn Du nur innerhalb Excel die Größe änderst, haben deine MB nix davon.

Wenn ich z.B. an der ersten Stelle dann ein anderes Bild einfüge, wird das alte nicht gelöscht

In einem Bildobjekt ist nur eins drin. Mache mal aus der xlsm eine zip und schaue dann in den Ordner xl\media. Da ist das oder sind die Bilder drin.

Die Mappe erste speichern können wenn mindesten Bild 1-3 eingefügt sind.

Du kannst prüfen, ob die Picture-Eigenschaft Nothing ist. Nimm einfach mal das Image-Objekt in die Überwachung und schaue Dir den Unterschied zwischen einem leeren und gefüllten Objekt an.