AW: Was willst du mit deinem Code...
08.09.2022 00:54:36
Oraculix
Hallo Danke für Deine Mühe!
Dein Code funktioniert Tadellos nur wenn ich die Userform aufrufe bekomme viele Fehler sehr komplex das ganze.(Sämtliche Code müssten dann umgeschrieben werden)
Ich muss das anders lösen.
Arbeite gerade an einer neuen Variante wo beim speichern der Mappe alle 260 Bilder gelöscht werden.(Damit bringe ich Mappe auf 16 Mb runter)
Das löschen klappt ja schon ganz gut aber das einfügen beim Start der Mappe da gibt es noch Probleme.
Sub SchauspielerBilderLöschen()
'Alle Bilder Löschen
Application.ScreenUpdating = False
Windows("!Filme.xlsm").Activate
On Error GoTo Error:
Worksheets("Schauspieler").Activate
Dim BC As Object
For Each BC In ActiveSheet.Pictures
BC.Delete
Next BC
'Grundbild für Azeige wiederherstellen(Leider wird das Image 1 auch gelöscht)
ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=231.574675324675, Top:=135.876623376623, _
Width:=325.081168831169, Height:=153.409090909091).Select
Error:
'Application.DisplayAlert = False
Range("A1").Select
Application.ScreenUpdating = True
End Sub
'Schauspieler bilder einfügen beim Start der Mappe
Sub SchauspielerBilderEinfügen()
'Mappe Öffnen
Workbooks.Open "D:\EMDB\HTML\Schauspieler_Bilder.xlsm"
'Kopieren
Windows("Schauspieler_Bilder.xlsm").Activate
ActiveSheet.Shapes.Range(Array("Picture 2")).Select
ActiveSheet.Shapes.SelectAll
Selection.Copy
Windows("!Filme.xlsm").Activate
'Einfügen
Windows("!Filme.xlsm").Activate
Worksheets("Schauspieler").Activate
Range("A1").Select
ActiveSheet.Paste
ActiveSheet.Buttons.Add(67267.6071428571, 103.5, 414.321428571429, _
23.1428571428571).Select
' ActiveSheet.Shapes("Picture 264").IncrementLeft 25.2029133858
Range("A1").Select
'Schauspieler bilder schließen
Windows("Schauspieler_Bilder.xlsm").Activate
Worksheets("SchauspielerBilder").Activate
ActiveWorkbook.Close 'SaveChanges:=False
Error:
'Application.DisplayAlert = False
Application.ScreenUpdating = True
End Sub
Gruß
Oraculix
